home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the Mac Game Programming Gurus / TricksOfTheMacGameProgrammingGurus.iso / More Source / C⁄C++ / Xconq 7.0d37 / source / kernel / read.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-05-02  |  84.5 KB  |  3,363 lines  |  [TEXT/KAHL]
  1. /* Interpretation of Xconq GDL.
  2.    Copyright (C) 1989, 1991, 1992, 1993, 1994, 1995 Stanley T. Shebs.
  3.  
  4. Xconq is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2, or (at your option)
  7. any later version.  See the file COPYING.  */
  8.  
  9. /* Syntax is el cheapo Lisp. */
  10.  
  11. #include "conq.h"
  12. extern int lookup_plan_type PROTO ((char *name));
  13. extern int lookup_task_type PROTO ((char *name));
  14. extern int lookup_goal_type PROTO ((char *name));
  15. #include "imf.h"
  16.  
  17. extern int actually_read_lisp;
  18.  
  19. static void module_and_line PROTO ((Module *module, char *buf));
  20. static void init_constant PROTO ((int key));
  21. static void init_self_eval PROTO ((int key));
  22. static void useless_form_warning PROTO ((Module *module, Obj *form));
  23. static void include_module PROTO ((Obj *form, Module *module));
  24. static void do_one_variant PROTO ((Module *module, struct a_variant *var, Obj *varsetdata));
  25. static void start_conditional PROTO ((Obj *form, Module *module));
  26. static void start_else PROTO ((Obj *form, Module *module));
  27. static void end_conditional PROTO ((Obj *form, Module *module));
  28. static Variant *interp_variant_defns PROTO ((Obj *lis));
  29. static void interp_utype PROTO ((Obj *form));
  30. static void fill_in_utype PROTO ((int u, Obj *list));
  31. static int set_utype_property PROTO ((int u, char *propname, Obj *val));
  32. static void interp_mtype PROTO ((Obj *form));
  33. static void fill_in_mtype PROTO ((int m, Obj *list));
  34. static void interp_ttype PROTO ((Obj *form));
  35. static void fill_in_ttype PROTO ((int t, Obj *list));
  36. static void interp_table PROTO ((Obj *form));
  37. static void add_to_table PROTO ((Obj *tablename, int tbl, Obj *clauses, int init));
  38. static void interp_one_clause PROTO ((Obj *tablename, int tbl, int lim1, int lim2, Obj *indexes1, Obj *indexes2, Obj *values));
  39. static void interp_variable PROTO ((Obj *form, int isnew));
  40. static void undefine_variable PROTO ((Obj *form));
  41. static void add_properties PROTO ((Obj *form));
  42. static int list_lengths_match PROTO ((Obj *types, Obj *values, char *formtype, Obj *form));
  43. static void add_to_utypes PROTO ((Obj *types, Obj *prop, Obj *values));
  44. static void add_to_mtypes PROTO ((Obj *types, Obj *prop, Obj *values));
  45. static void add_to_ttypes PROTO ((Obj *types, Obj *prop, Obj *values));
  46. static void interp_world PROTO ((Obj *form));
  47. static void interp_area PROTO ((Obj *form));
  48. static void fill_in_terrain PROTO ((Obj *contents));
  49. static void fill_in_aux_terrain PROTO ((Obj *contents));
  50. static void fill_in_people_sides PROTO ((Obj *contents));
  51. static void fill_in_features PROTO ((Obj *contents));
  52. static void fill_in_elevations PROTO ((Obj *contents));
  53. static void fill_in_cell_material PROTO ((Obj *contents));
  54. static void fill_in_temperatures PROTO ((Obj *contents));
  55. static void fill_in_winds PROTO ((Obj *contents));
  56. static void fill_in_clouds PROTO ((Obj *contents));
  57. static void fill_in_cloud_bottoms PROTO ((Obj *contents));
  58. static void fill_in_cloud_heights PROTO ((Obj *contents));
  59. static void interp_side PROTO ((Obj *form, Side *side));
  60. static void check_name_uniqueness PROTO ((Side *side, char *str, char *kind));
  61. static void merge_unit_namers PROTO ((Side *side, Obj *lis));
  62. static void interp_side_value_list PROTO ((short *arr, Obj *lis));
  63. static void fn_set_terrain_view PROTO ((int x, int y, int val));
  64. static void read_terrain_view PROTO ((Side *side, Obj *contents));
  65. static void fn_set_unit_view PROTO ((int x, int y, int val));
  66. static void read_unit_view PROTO ((Side *side, Obj *contents));
  67. static void fn_set_unit_view_date PROTO ((int x, int y, int val));
  68. static void read_unit_view_dates PROTO ((Side *side, Obj *contents));
  69. static void read_utype_doctrine PROTO ((Side *side, Obj *ulist, Obj *props));
  70. static void interp_player PROTO ((Obj *form));
  71. static void fill_in_player PROTO ((struct a_player *player, Obj *props));
  72. static void interp_agreement PROTO ((Obj *form));
  73. static void interp_unit_defaults PROTO ((Obj *form));
  74. static int utype_from_name PROTO ((char *str));
  75. static void interp_unit PROTO ((Obj *form));
  76. static void interp_utype_value_list PROTO ((short *arr, Obj *lis));
  77. static void interp_mtype_value_list PROTO ((short *arr, Obj *lis));
  78. static void interp_unit_act PROTO ((Unit *unit, Obj *props));
  79. static void interp_unit_plan PROTO ((Unit *unit, Obj *props));
  80. static Task *interp_task PROTO ((Obj *form));
  81. static Goal *interp_goal PROTO ((Obj *form));
  82. static void interp_namer PROTO ((Obj *form));
  83. static void interp_text_generator PROTO ((Obj *form));
  84. static void interp_scorekeeper PROTO ((Obj *form));
  85. static void interp_history PROTO ((Obj *form));
  86. static void interp_past_unit PROTO ((Obj *form));
  87.  
  88. static void too_many_types PROTO ((char *typename, int maxnum, Obj *name));
  89. static void unknown_property PROTO ((char *type, char *inst, char *name));
  90. static void read_layer PROTO ((Obj *contents, void (*setter)(int, int, int)));
  91. static void read_rle PROTO ((Obj *contents, void (*setter)(int, int, int), short *chartable));
  92.  
  93. /* This is the list of side defaults that will be applied
  94.    to all sides read subsequently. */
  95.  
  96. Obj *side_defaults;
  97.  
  98. /* These variables indicate whether new types can still be defined.
  99.    Once a table or list of types is manipulated, these are turned off. */
  100.  
  101. int canaddutype = TRUE;
  102. int canaddmtype = TRUE;
  103. int canaddttype = TRUE;
  104.  
  105. /* This is the module from which forms are being read and
  106.    interpreted, if they are coming from a module. */
  107.  
  108. Module *curmodule = NULL;
  109.  
  110. /* True if game will start up in the middle of a turn. */
  111.  
  112. int midturnrestore = FALSE;
  113.  
  114. /* The count of cells that did not have valid terrain data. */
  115.  
  116. int numbadterrain = 0;
  117.  
  118. /* True if should warn about bad terrain. */
  119.  
  120. int warnbadterrain = TRUE;
  121.  
  122. char *readerrbuf = NULL;
  123.  
  124. int uxoffset = 0, uyoffset = 0;
  125.  
  126. int default_unit_side_number = -1;
  127.  
  128. int default_unit_cp = -1;
  129.  
  130. int default_unit_hp = -1;
  131.  
  132. int default_unit_cxp = -1;
  133.  
  134. int default_unit_z = -1;
  135.  
  136. int default_transport_id = -1;
  137.  
  138. Obj *default_unit_hook;
  139.  
  140. /* This is the table of keywords. */
  141.  
  142. struct a_key {
  143.     char *name;
  144.     short key;
  145.     short value;
  146. } keywordtable[] = {
  147.  
  148. #undef  DEF_KWD
  149. #define DEF_KWD(NAME,CODE,VALUE)  { NAME, CODE, VALUE },
  150.  
  151. #include "keyword.def"
  152.  
  153.     { NULL, 0 }
  154. };
  155.  
  156. /* Given a string, return the enum of the matching keyword,
  157.    if found, else -1. */
  158.  
  159. int
  160. keyword_code(str)
  161. char *str;
  162. {
  163.     int i;
  164.  
  165.     /* (should do a binary search first, then switch to exhaustive) */
  166.     for (i = 0; keywordtable[i].name != NULL; ++i) {
  167.     if (strcmp(str, keywordtable[i].name) == 0) return keywordtable[i].key;
  168.     }
  169.     return (-1);
  170. }
  171.  
  172. char *
  173. keyword_name(k)
  174. enum keywords k;
  175. {
  176.     return keywordtable[k].name;
  177. }
  178.  
  179. int
  180. keyword_value(k)
  181. enum keywords k;
  182. {
  183.     return keywordtable[k].value;
  184. }
  185.  
  186. #define TYPEPROP(TYPES, N, DEFNS, I, TYPE)  \
  187.   ((TYPE *) &(((char *) (&(TYPES[N])))[DEFNS[I].offset]))[0]
  188.  
  189. /* This is a generic syntax check and escape. */
  190.  
  191. #define SYNTAX(X,TEST,MSG)  \
  192.   if (!(TEST)) {  \
  193.       syntax_error((X), (MSG));  \
  194.       return;  \
  195.   }
  196.   
  197. #define SYNTAX_RETURN(X,TEST,MSG,RET)  \
  198.   if (!(TEST)) {  \
  199.       syntax_error((X), (MSG));  \
  200.       return (RET);  \
  201.   }
  202.  
  203. void  
  204. syntax_error(x, msg)
  205. Obj *x;
  206. char *msg;
  207. {
  208.     if (readerrbuf == NULL)
  209.       readerrbuf = (char *) xmalloc(BUFSIZE);
  210.     sprintlisp(readerrbuf, x);
  211.     read_warning("syntax error in %s - %s", readerrbuf, msg);
  212. }
  213.  
  214. /* This is specifically for typechecking. */
  215.  
  216. #define TYPECHECK(PRED,X,MSG)  \
  217.   if (!PRED(X)) { type_error((X), (MSG));  return; }
  218.  
  219. void
  220. type_error(x, msg)
  221. Obj *x;
  222. char *msg;
  223. {
  224.     if (readerrbuf == NULL)
  225.       readerrbuf = (char *) xmalloc(BUFSIZE);
  226.     sprintlisp(readerrbuf, x);
  227.     read_warning("type error in %s - %s", readerrbuf, msg);
  228. }
  229.  
  230. /* Parse the (propertyname value) lists that most forms use. */
  231.  
  232. #define PARSE_PROPERTY(BDG,NAME,VAL)  \
  233.   SYNTAX(BDG, (consp(BDG) && symbolp(car(BDG))), "property binding");  \
  234.   (NAME) = c_string(car(BDG));  \
  235.   (VAL) = cadr(BDG);
  236.  
  237. /* This is like init_warning, but with a module and line(s) glued in. */
  238.  
  239. void
  240. #ifdef __STDC__
  241. read_warning(char *str, ...)
  242. #else
  243. read_warning(str, a1, a2, a3, a4, a5, a6, a7, a8, a9)
  244. char *str;
  245. long a1, a2, a3, a4, a5, a6, a7, a8, a9;
  246. #endif
  247. {
  248.     char buf[BUFSIZE];
  249.  
  250.     module_and_line(curmodule, buf);
  251. #ifdef __STDC__
  252.     {
  253.     va_list ap;
  254.  
  255.     va_start(ap, str);
  256.     vtprintf(buf, str, ap);
  257.     va_end(ap);
  258.     }
  259. #else
  260.     tprintf(buf, str, a1, a2, a3, a4, a5, a6, a7, a8, a9);
  261. #endif
  262.     low_init_warning(buf);
  263. }
  264.  
  265. static void
  266. module_and_line(module, buf)
  267. Module *module;
  268. char *buf;
  269. {
  270.     if (module) {
  271.     if (module->startlineno != module->endlineno) {
  272.         sprintf(buf, "%s:%d-%d: ",
  273.             module->name, module->startlineno, module->endlineno);
  274.     } else {
  275.         sprintf(buf, "%s:%d: ",
  276.             module->name, module->startlineno);
  277.     }
  278.     } else {
  279.     buf[0] = '\0';
  280.     }
  281. }
  282.  
  283. static void
  284. init_constant(key)
  285. int key;
  286. {
  287.     Obj *sym = intern_symbol(keyword_name(key));
  288.  
  289.     setq(sym, new_number(keyword_value(key)));
  290.     flag_as_constant(sym);
  291. }
  292.  
  293. static void
  294. init_self_eval(key)
  295. int key;
  296. {
  297.     Obj *sym = intern_symbol(keyword_name(key));
  298.  
  299.     setq(sym, sym);
  300.     flag_as_constant(sym);
  301. }
  302.  
  303. void
  304. init_predefined_symbols()
  305. {
  306.     /* Predefined constants. */
  307.     init_constant(K_FALSE);
  308.     init_constant(K_TRUE);
  309.     init_constant(K_NON_UNIT);
  310.     init_constant(K_NON_MATERIAL);
  311.     init_constant(K_NON_TERRAIN);
  312.     init_constant(K_CELL);
  313.     init_constant(K_BORDER);
  314.     init_constant(K_CONNECTION);
  315.     init_constant(K_COATING);
  316.     init_constant(K_RIVER_X);
  317.     init_constant(K_VALLEY_X);
  318.     init_constant(K_ROAD_X);
  319.     init_constant(K_OVER_NOTHING);
  320.     init_constant(K_OVER_OWN);
  321.     init_constant(K_OVER_BORDER);
  322.     init_constant(K_OVER_ALL);
  323.     /* Random self-evaluating symbols. */
  324.     init_self_eval(K_AND);
  325.     init_self_eval(K_OR);
  326.     init_self_eval(K_NOT);
  327.     init_self_eval(K_REJECT);
  328.     init_self_eval(K_RESET);
  329.     init_self_eval(K_USUAL);
  330.     init_self_eval(K_APPEAR);
  331.     init_self_eval(K_DISAPPEAR);
  332.     /* Leave these unbound so that first ref computes correct list. */
  333.     intern_symbol(keyword_name(K_USTAR));
  334.     intern_symbol(keyword_name(K_MSTAR));
  335.     intern_symbol(keyword_name(K_TSTAR));
  336.     /* This just needs to be inited somewhere. */
  337.     side_defaults = lispnil;
  338. }
  339.  
  340. /* This is the basic interpreter of a form appearing in a module. */
  341.  
  342. void
  343. interp_form(module, form)
  344. Module *module;
  345. Obj *form;
  346. {
  347.     Obj *thecar;
  348.     char *name;
  349.  
  350.     /* Put the passed-in module into a global; for use in error messages. */
  351.     curmodule = module;
  352.     if (consp(form) && symbolp(thecar = car(form))) {
  353.     name = c_string(thecar);
  354.     if (Debug) {
  355.         /* If in a module, report the line number(s) of a form. */
  356.         if (module != NULL) {
  357.         Dprintf("Line %d", module->startlineno);
  358.         if (module->endlineno != module->startlineno)
  359.           Dprintf("-%d", module->endlineno);
  360.         }
  361.         Dprintf(": (%s ", name);
  362.         Dprintlisp(cadr(form));
  363.         if (cddr(form) != lispnil) {
  364.         Dprintf(" ");
  365.         Dprintlisp(caddr(form));
  366.         if (cdr(cddr(form)) != lispnil)
  367.           Dprintf(" ...");
  368.         }
  369.         Dprintf(")\n");
  370.     }
  371.     switch (keyword_code(name)) {
  372.       case K_GAME_MODULE:
  373.         interp_game_module(form, module);
  374.         load_base_module(module);
  375.         break;
  376. #ifndef SPECIAL
  377.       case K_UNIT_TYPE:
  378.         interp_utype(form);
  379.         break;
  380.       case K_MATERIAL_TYPE:
  381.         interp_mtype(form);
  382.         break;
  383.       case K_TERRAIN_TYPE:
  384.         interp_ttype(form);
  385.         break;
  386.       case K_TABLE:
  387.         interp_table(form);
  388.         break;
  389.           case K_DEFINE:
  390.         interp_variable(form, TRUE);
  391.         break;
  392.       case K_SET:
  393.         interp_variable(form, FALSE);
  394.         break;
  395.       case K_UNDEFINE:
  396.         undefine_variable(form);
  397.         break;
  398.       case K_ADD:
  399.         add_properties(form);
  400.         break;
  401. #endif /* n SPECIAL */
  402.       case K_WORLD:
  403.         interp_world(form);
  404.         break;
  405.       case K_AREA:
  406.         interp_area(form);
  407.         break;
  408.       case K_SIDE:
  409.         interp_side(form, NULL);
  410.         break;
  411.       case K_SIDE_DEFAULTS:
  412.         side_defaults = cdr(form);
  413.         break;
  414.       case K_INDEPENDENT_UNITS:
  415.         interp_side(form, indepside);
  416.         break;
  417.       case K_PLAYER:
  418.         interp_player(form);
  419.         break;
  420.       case K_AGREEMENT:
  421.         interp_agreement(form);
  422.         break;
  423.       case K_SCOREKEEPER:
  424.         interp_scorekeeper(form);
  425.         break;
  426.       case K_EVT:
  427.         interp_history(form);
  428.         break;
  429.       case K_EXU:
  430.         interp_past_unit(form);
  431.         break;
  432.       case K_BATTLE:
  433.         read_warning("battle objects not yet supported");
  434.         break;
  435.       case K_UNIT:
  436.         /* This is for when the unit type name matches a keyword */
  437.         interp_unit(cdr(form));
  438.         break;
  439.       case K_UNIT_DEFAULTS:
  440.         interp_unit_defaults(cdr(form));
  441.         break;
  442.       case K_NAMER:
  443.         interp_namer(form);
  444.         break;
  445.       case K_TEXT:
  446.         interp_text_generator(form);
  447.         break;
  448.       case K_IMF:
  449.         interp_imf(form);
  450.         break;
  451.       case K_PALETTE:
  452.         interp_palette(form);
  453.         break;
  454.       case K_COLOR:
  455.         interp_color(form);
  456.         break;
  457.       case K_INCLUDE:
  458.         include_module(form, module);
  459.         break;
  460.       case K_IF:
  461.         start_conditional(form, module);
  462.         break;
  463.       case K_ELSE:
  464.         start_else(form, module);
  465.         break;
  466.       case K_END_IF:
  467.         end_conditional(form, module);
  468.         break;
  469.       case K_PRINT:
  470. #ifdef USE_CONSOLE
  471.         printlisp(cadr(form));
  472.         if (symbolp(cadr(form))) {
  473.         if (boundp(cadr(form))) {
  474.             printf(" -> ");
  475.             printlisp(symbol_value(cadr(form)));
  476.         } else {
  477.             printf(" <unbound>");
  478.         }
  479.         }
  480.         printf("\n");
  481. #else
  482.         /* should send to the interface to handle */
  483. #endif /* USE_CONSOLE */
  484.         break;
  485.       default:
  486.         if (numutypes == 0)
  487.           load_default_game();
  488.         if (utype_from_name(name) != NONUTYPE) {
  489.         interp_unit(form);
  490.         } else {
  491.         useless_form_warning(module, form);
  492.         }
  493.     }
  494.     } else {
  495.     useless_form_warning(module, form);
  496.     }
  497. }
  498.  
  499. static void
  500. useless_form_warning(module, form)
  501. Module *module;
  502. Obj *form;
  503. {
  504.     char posbuf[BUFSIZE], buf[BUFSIZE];
  505.  
  506.     if (!actually_read_lisp)
  507.       return;
  508.     module_and_line(module, posbuf);
  509.     sprintlisp(buf, form);
  510.     init_warning("%sA useless form: %s", posbuf, buf);
  511. }
  512.  
  513. /* Inclusion is half-module-like, not strictly textual. */
  514.  
  515. static void
  516. include_module(form, module)
  517. Obj *form;
  518. Module *module;
  519. {
  520.     char *name;
  521.     Obj *mname = cadr(form);
  522.     Module *submodule;
  523.  
  524.     SYNTAX(mname, (symbolp(mname) || stringp(mname)),
  525.        "Included module name not a string or symbol");
  526.     name = c_string(mname);
  527.     Dprintf("Including \"%s\" ...\n", name);
  528.     submodule = add_game_module(name, module);
  529.     load_game_module(submodule, TRUE);
  530.     if (submodule->loaded) {
  531.         do_module_variants(submodule, cddr(form));
  532.     } 
  533.     Dprintf("... Done including \"%s\".\n", name);
  534. }
  535.  
  536. /* Interpret the given list of variants. */
  537.  
  538. void
  539. do_module_variants(module, lis)
  540. Module *module;
  541. Obj *lis;
  542. {
  543.     int i, found;
  544.     Obj *restset, *varset;
  545.     Variant *var;
  546.  
  547.     if (module->variants == NULL)
  548.       return; /* error? */
  549.     for (restset = lis; restset != lispnil; restset = cdr(restset)) {
  550.     varset = car(restset);
  551.     found = FALSE;
  552.     for (i = 0; module->variants[i].id != lispnil; ++i) {
  553.         var = &(module->variants[i]);
  554.         if (equal(car(varset), var->id)) {
  555.         do_one_variant(module, var, cdr(varset));
  556.         found = TRUE;
  557.         }
  558.     }
  559.     if (!found) {
  560.         read_warning("Mystifying variant");
  561.     }
  562.     }
  563.     /* Now implement all the defaults. */
  564.     for (i = 0; module->variants[i].id != lispnil; ++i) {
  565.     var = &(module->variants[i]);
  566.     if (!var->used)
  567.       do_one_variant(module, var, lispnil);
  568.     }
  569. }
  570.  
  571. static void
  572. do_one_variant(module, var, varsetdata)
  573. Module *module;
  574. Variant *var;
  575. Obj *varsetdata;
  576. {
  577.     int val, caseval;
  578.     int width = 0, height = 0, circumference, latitude, longitude;
  579.     int rtime, rtimeperturn, rtimeperside;
  580.     char *vartypename = c_string(var->id);
  581.     Obj *restcases, *headcase, *rest, *filler;
  582.  
  583.     if (Debug) {
  584.     if (readerrbuf == NULL)
  585.       readerrbuf = (char *) xmalloc(BUFSIZE);
  586.         sprintlisp(readerrbuf, varsetdata);
  587.         Dprintf("Module %s variant %s being set to `%s'\n",
  588.             module_desig(module), vartypename, readerrbuf);
  589.     }
  590.     switch (keyword_code(vartypename)) {
  591.       case K_WORLD_SEEN:
  592.     val = (varsetdata == lispnil ?
  593.            (var->dflt == lispnil ? FALSE : c_number(eval(var->dflt))) :
  594.            c_number(eval(car(varsetdata))));
  595.     set_g_terrain_seen(val);
  596.     break;
  597.       case K_SEE_ALL:
  598.     val = (varsetdata == lispnil ?
  599.            (var->dflt == lispnil ? FALSE : c_number(eval(var->dflt))) :
  600.            c_number(eval(car(varsetdata))));
  601.     set_g_see_all(val);
  602.     break;
  603.       case K_SEQUENTIAL:
  604.     val = (varsetdata == lispnil ?
  605.            (var->dflt == lispnil ? FALSE : c_number(eval(var->dflt))) :
  606.            c_number(eval(car(varsetdata))));
  607.     set_g_use_side_priority(val);
  608.     break;
  609.       case K_WORLD_SIZE:
  610.           filler = lispnil;
  611.     if (varsetdata != lispnil) {
  612.         filler = varsetdata;
  613.     } else if (var->dflt != lispnil) {
  614.         filler = var->dflt;
  615.     }
  616.     /* Pick the width and height out of the list. */
  617.     if (filler != lispnil) {
  618.         width = c_number(eval(car(filler)));
  619.         filler = cdr(filler);
  620.     }
  621.     if (filler != lispnil) {
  622.         height = c_number(eval(car(filler)));
  623.         filler = cdr(filler);
  624.     } else {
  625.         height = width;
  626.     }
  627.     /* Pick up a circumference if given. */
  628.     if (filler != lispnil) {
  629.         circumference = c_number(eval(car(filler)));
  630.         set_world_circumference(circumference, TRUE);
  631.         filler = cdr(filler);
  632.     }
  633.     /* This is more useful after the circumference has been set. */
  634.     if (width > 0 && height > 0)
  635.       set_area_shape(width, height, TRUE);
  636.     /* Pick up latitude and longitude if given. */
  637.     if (filler != lispnil) {
  638.         latitude = c_number(eval(car(filler)));
  639.         /* (should use a setter routine?) */
  640.         area.latitude = latitude;
  641.         filler = cdr(filler);
  642.     }
  643.     if (filler != lispnil) {
  644.         longitude = c_number(eval(car(filler)));
  645.         /* (should use a setter routine?) */
  646.         area.longitude = longitude;
  647.         filler = cdr(filler);
  648.     }
  649.     break;
  650.       case K_REAL_TIME:
  651.           filler = lispnil;
  652.     if (varsetdata != lispnil) {
  653.         filler = varsetdata;
  654.     } else if (var->dflt != lispnil) {
  655.         filler = var->dflt;
  656.     }
  657.     if (filler != lispnil) {
  658.         rtime = c_number(eval(car(filler)));
  659.         filler = cdr(filler);
  660.     } else {
  661.         rtime = 0;
  662.     }
  663.     if (filler != lispnil) {
  664.         rtimeperside = c_number(eval(car(filler)));
  665.         filler = cdr(filler);
  666.     } else {
  667.         rtimeperside = 0;
  668.     }
  669.     if (filler != lispnil) {
  670.         rtimeperturn = c_number(eval(car(filler)));
  671.         filler = cdr(filler);
  672.     } else {
  673.         rtimeperturn = 0;
  674.     }
  675.     /* If the values were specified, tweak the official
  676.        realtime globals. */
  677.     if (rtime > 0)
  678.       set_g_rt_for_game(rtime);
  679.     if (rtimeperside > 0)
  680.       set_g_rt_per_side(rtimeperside);
  681.     if (rtimeperturn > 0)
  682.       set_g_rt_per_turn(rtimeperturn);
  683.     break;
  684.       default:
  685.     /* This is the general case. */
  686.     val = (varsetdata == lispnil ?
  687.            (var->dflt == lispnil ? FALSE : c_number(eval(var->dflt))) :
  688.            c_number(eval(car(varsetdata))));
  689.     for (restcases = var->cases; restcases != lispnil; restcases = cdr(restcases)) {
  690.         headcase = car(restcases);
  691.         caseval = c_number(eval(car(headcase)));
  692.         if (caseval == val) {
  693.             for (rest = cdr(headcase); rest != lispnil; rest = cdr(rest)) {
  694.             interp_form(module, car(rest));
  695.             }
  696.         }
  697.     }
  698.     break;
  699.     }
  700.     /* Flag the variant as having been specified. */
  701.     var->used = TRUE;
  702. }
  703.  
  704. Obj *cond_read_stack;
  705.  
  706. static void
  707. start_conditional(form, module)
  708. Obj *form;
  709. Module *module;
  710. {
  711.     Obj *testform, *rslt;
  712.  
  713.     testform = cadr(form);
  714.     rslt = eval(testform);
  715.     if (numberp(rslt) && c_number(rslt) == 1) {
  716.     actually_read_lisp = TRUE;
  717.     } else {
  718.     actually_read_lisp = FALSE;
  719.     }
  720. }
  721.  
  722. static void
  723. start_else(form, module)
  724. Obj *form;
  725. Module *module;
  726. {
  727.     /* should match up with cond read stack */
  728.     actually_read_lisp = !actually_read_lisp;
  729. }
  730.  
  731. static void
  732. end_conditional(form, module)
  733. Obj *form;
  734. Module *module;
  735. {
  736.     /* should match up with cond read stack */
  737.     actually_read_lisp = TRUE;
  738. }
  739.  
  740. /* Given a list of variant-defining forms, allocate and return an
  741.    array of variant objects. */
  742.  
  743. static Variant *
  744. interp_variant_defns(lis)
  745. Obj *lis;
  746. {
  747.     int i = 0, len;
  748.     Obj *head;
  749.     Variant *varray, *var;
  750.  
  751.     if (lis == lispnil)
  752.       return NULL;
  753.     len = length(lis);
  754.     varray = (Variant *) xmalloc((len + 1) * sizeof(Variant));
  755.     for (i = 0; i < len; ++i) {
  756.     var = varray + i;
  757.     var->id = var->dflt = var->range = var->cases = lispnil;
  758.     head = car(lis);
  759.     if (symbolp(head)) {
  760.         var->id = head;
  761.         var->name = c_string(var->id);
  762.     } else if (consp(head)) {
  763.         if (stringp(car(head))) {
  764.         var->name = c_string(car(head));
  765.         head = cdr(head);
  766.         }
  767.         if (symbolp(car(head))) {
  768.         var->id = car(head);
  769.         if (var->name == NULL)
  770.           var->name = c_string(var->id);
  771.         head = cdr(head);
  772.         } else if (var->name != NULL) {
  773.             var->id = intern_symbol(var->name);
  774.         } else {
  775.         /* error */
  776.         }
  777.         /* Pick up a default value if specified. */
  778.         if (!consp(car(head))) {
  779.             var->dflt = car(head);
  780.             head = cdr(head);
  781.         } else if (match_keyword(var->id, K_WORLD_SIZE)) {
  782.             var->dflt = car(head);
  783.             head = cdr(head);
  784.         } else if (match_keyword(var->id, K_REAL_TIME)) {
  785.             var->dflt = car(head);
  786.             head = cdr(head);
  787.         }
  788.         /* (should recognize and pick up a range spec if present) */
  789.         /* Case clauses are everything that's left over. */
  790.         var->cases = head;
  791.     } else {
  792.         /* error */
  793.     }
  794.     lis = cdr(lis);
  795.     }
  796.     /* Terminate the array with an id that never appears otherwise. */
  797.     varray[i].id = lispnil;
  798.     return varray;
  799. }
  800.  
  801. /* Digest the form defining the module as a whole. */
  802.  
  803. void
  804. interp_game_module(form, module)
  805. Obj *form;
  806. Module *module;
  807. {
  808.     char *name = NULL, *propname, *strval = NULL;
  809.     Obj *props = cdr(form), *bdg, *propval;
  810.  
  811.     if (module == NULL) return;  /* why is this here? */
  812.  
  813.     /* Collect and set the module name if supplied by this form. */
  814.     if (stringp(car(props))) {
  815.     name = c_string(car(props));
  816.     props = cdr(props);
  817.     }
  818.     if (name != NULL) {
  819.     if (empty_string(module->name)) {
  820.         module->name = name;
  821.     } else {
  822.         if (strcmp(name, module->name) != 0) {
  823.         read_warning("Module name `%s' does not match declared name `%s', ignoring declared name",
  824.                  module->name, name);
  825.         }
  826.     }
  827.     }
  828.     for (; props != lispnil; props = cdr(props)) {
  829.     bdg = car(props);
  830.     PARSE_PROPERTY(bdg, propname, propval);
  831.     if (stringp(propval)) strval = c_string(propval);
  832.     switch (keyword_code(propname)) {
  833.       case K_TITLE:
  834.         module->title = strval;
  835.         break;
  836.       case K_BLURB:
  837.         module->blurb = strval;
  838.         break;
  839.       case K_PICTURE_NAME:
  840.         module->picturename = strval;
  841.         break;
  842.       case K_BASE_MODULE:
  843.         module->basemodulename = strval;
  844.         break;
  845.       case K_DEFAULT_BASE_MODULE:
  846.         module->defaultbasemodulename = strval;
  847.         break;
  848.       case K_BASE_GAME:
  849.         module->basegame= strval;
  850.         break;
  851.       case K_INSTRUCTIONS:
  852.         /* The instructions are a list of strings. */
  853.         module->instructions = propval;
  854.         break;
  855.       case K_VARIANTS:
  856.         module->variants = interp_variant_defns(cdr(bdg));
  857.         break;
  858.       case K_NOTES:
  859.         /* The player notes are a list of strings. */
  860.         module->notes = propval;
  861.         break;
  862.       case K_DESIGN_NOTES:
  863.         /* The design notes are a list of strings. */
  864.         module->designnotes = propval;
  865.         break;
  866.       case K_VERSION:
  867.         module->version = strval;
  868.         break;
  869.       case K_PROGRAM_VERSION:
  870.         module->programversion = strval;
  871.         break;
  872.       default:
  873.         unknown_property("game module", module->name, propname);
  874.     }
  875.     }
  876.     /* Should be smarter about earlier vs later versions. */
  877.     if (module->programversion != NULL
  878.     && strcmp(module->programversion, version_string()) != 0) {
  879.     /* This should become some sort of alert on some systems. */
  880.     read_warning("The module `%s' is claimed to be for Xconq version `%s', but you are actually running version `%s'",
  881.              module->name, module->programversion, version_string());
  882.     }
  883. }
  884.  
  885. /* The following code is unneeded if all the types have been compiled in. */
  886.  
  887. #ifndef SPECIAL
  888.  
  889. /* Create a new type of unit and fill in info about it. */
  890.  
  891. static void
  892. interp_utype(form)
  893. Obj *form;
  894. {
  895.     int u;
  896.     Obj *name = cadr(form), *utype;
  897.  
  898.     TYPECHECK(symbolp, name, "unit-type name not a symbol");
  899.     if (!canaddutype)
  900.       read_warning("Should not be defining more unit types");
  901.     if (numutypes < MAXUTYPES) {
  902.     u = numutypes++;
  903.     utype = new_utype(u);
  904.     /* Set default values for the unit type's props first. */
  905.     /* Any default type name shouldn't confuse the code below. */
  906.     default_unit_type(u);
  907.     setq(name, utype);
  908.     /* Set the values of random props. */
  909.     fill_in_utype(u, cddr(form));
  910.     /* If no internal type name string given, use the defined name. */
  911.     if (empty_string(u_internal_name(u))) {
  912.         set_u_internal_name(u, c_string(name));
  913.     }
  914.     if (empty_string(u_type_name(u))) {
  915.         set_u_type_name(u, u_internal_name(u));
  916.     }
  917.     /* If the official type name is different from the internal name,
  918.        make it a variable bound to the type. */ 
  919.     if (strcmp(u_type_name(u), u_internal_name(u)) != 0) {
  920.         setq(intern_symbol(u_type_name(u)), utype);
  921.     }
  922.     } else {
  923.     too_many_types("unit", MAXUTYPES, name);
  924.     }
  925.     /* Blast any cached list of types. */
  926.     makunbound(intern_symbol(keyword_name(K_USTAR)));
  927.     eval_symbol(intern_symbol(keyword_name(K_USTAR)));
  928. }
  929.  
  930. /* Trudge through assorted properties, filling them in. */
  931.  
  932. static void
  933. fill_in_utype(u, list)
  934. int u;
  935. Obj *list;
  936. {
  937.     char *propname;
  938.     Obj *bdg, *val;
  939.  
  940.     for ( ; list != lispnil; list = cdr(list)) {
  941.     bdg = car(list);
  942.     PARSE_PROPERTY(bdg, propname, val);
  943.     set_utype_property(u, propname, val);
  944.     }
  945. }
  946.  
  947. /* Given a unit type, property name, and a value, find the
  948.    definition of the property and set its value. */
  949.  
  950. static int
  951. set_utype_property(u, propname, val)
  952. int u;
  953. char *propname;
  954. Obj *val;
  955. {
  956.     int i, found = FALSE;
  957.  
  958.     for (i = 0; utypedefns[i].name != NULL; ++i) {
  959.     if (strcmp(propname, utypedefns[i].name) == 0) {
  960.         if (utypedefns[i].intgetter) {
  961.         TYPEPROP(utypes, u, utypedefns, i, short) =
  962.           c_number(eval(val));
  963.         } else if (utypedefns[i].strgetter) {
  964.         TYPEPROP(utypes, u, utypedefns, i, char *) =
  965.           c_string(eval(val));
  966.         } else {
  967.         TYPEPROP(utypes, u, utypedefns, i, Obj *) = val;
  968.         }
  969.         found = TRUE;
  970.         break;
  971.     }
  972.     }
  973.     if (!found) unknown_property("unit type", u_type_name(u), propname);
  974.     return found;
  975. }
  976.  
  977. /* Declare a new type of material and fill in info about it. */
  978.  
  979. static void
  980. interp_mtype(form)
  981. Obj *form;
  982. {
  983.     int m;
  984.     Obj *name = cadr(form), *mtype;
  985.     
  986.     TYPECHECK(symbolp, name, "material-type name not a symbol");
  987.     if (!canaddmtype)
  988.       read_warning("Should not be defining more material types");
  989.     if (nummtypes < MAXMTYPES) {
  990.     m = nummtypes++;
  991.     mtype = new_mtype(m);
  992.     /* Set default values for the material type's properties first. */
  993.     default_material_type(m);
  994.     setq(name, mtype);
  995.     /* Set the values of random props. */
  996.     fill_in_mtype(m, cddr(form));
  997.     /* If no type name string given, use the defined name. */
  998.     if (empty_string(m_type_name(m))) {
  999.         set_m_type_name(m, c_string(name));
  1000.     }
  1001.     } else {
  1002.     too_many_types("material", MAXMTYPES, name);
  1003.     }
  1004.     /* Blast and remake any cached list of types. */
  1005.     makunbound(intern_symbol(keyword_name(K_MSTAR)));
  1006.     eval_symbol(intern_symbol(keyword_name(K_MSTAR)));
  1007. }
  1008.  
  1009. /* Go through a list of prop name/value pairs and fill in the
  1010.    material type description from them. */
  1011.  
  1012. static void
  1013. fill_in_mtype(m, list)
  1014. int m;
  1015. Obj *list;
  1016. {
  1017.     int i, found;
  1018.     Obj *bdg, *val;
  1019.     char *propname;
  1020.  
  1021.     for ( ; list != lispnil; list = cdr(list)) {
  1022.     bdg = car(list);
  1023.     PARSE_PROPERTY(bdg, propname, val);
  1024.     found = FALSE;
  1025.     for (i = 0; mtypedefns[i].name != NULL; ++i) {
  1026.         if (strcmp(propname, mtypedefns[i].name) == 0) {
  1027.         if (mtypedefns[i].intgetter) {
  1028.             TYPEPROP(mtypes, m, mtypedefns, i, short) =
  1029.               c_number(eval(val));
  1030.         } else if (mtypedefns[i].strgetter) {
  1031.             TYPEPROP(mtypes, m, mtypedefns, i, char *) =
  1032.               c_string(eval(val));
  1033.         } else {
  1034.             TYPEPROP(mtypes, m, mtypedefns, i, Obj *) = val;
  1035.         }
  1036.         found = TRUE;
  1037.         break;
  1038.         }
  1039.     }
  1040.     if (!found) unknown_property("material type", m_type_name(m), propname);
  1041.     }
  1042. }
  1043.  
  1044. /* Declare a new type of terrain and fill in info about it. */
  1045.  
  1046. static void
  1047. interp_ttype(form)
  1048. Obj *form;
  1049. {
  1050.     int t;
  1051.     Obj *name = cadr(form), *ttype;
  1052.  
  1053.     TYPECHECK(symbolp, name, "terrain-type name not a symbol");
  1054.     if (!canaddttype)
  1055.       read_warning("Should not be defining more terrain types");
  1056.     if (numttypes < MAXTTYPES) {
  1057.     t = numttypes++;
  1058.     ttype = new_ttype(t);
  1059.     /* Set default values for the terrain type's props first. */
  1060.     default_terrain_type(t);
  1061.     setq(name, ttype);
  1062.     /* Set the values of random properties. */
  1063.     fill_in_ttype(t, cddr(form));
  1064.     /* If no type name string given, use the defined name. */
  1065.     if (empty_string(t_type_name(t))) {
  1066.         set_t_type_name(t, c_string(name));
  1067.     }
  1068.     } else {
  1069.     too_many_types("terrain", MAXTTYPES, name);
  1070.     }
  1071.     /* Blast and remake any cached list of all types. */
  1072.     makunbound(intern_symbol(keyword_name(K_TSTAR)));
  1073.     eval_symbol(intern_symbol(keyword_name(K_TSTAR)));
  1074. }
  1075.  
  1076. /* Go through a list of prop name/value pairs and fill in the
  1077.    terrain type description from them. */
  1078.  
  1079. static void
  1080. fill_in_ttype(t, list)
  1081. int t;
  1082. Obj *list;
  1083. {
  1084.     int i, found;
  1085.     char *propname;
  1086.     Obj *bdg, *val;
  1087.  
  1088.     for ( ; list != lispnil; list = cdr(list)) {
  1089.     bdg = car(list);
  1090.     PARSE_PROPERTY(bdg, propname, val);
  1091.     found = FALSE;
  1092.     for (i = 0; ttypedefns[i].name != NULL; ++i) {
  1093.         if (strcmp(propname, ttypedefns[i].name) == 0) {
  1094.         if (ttypedefns[i].intgetter) {
  1095.             TYPEPROP(ttypes, t, ttypedefns, i, short) =
  1096.               c_number(eval(val));
  1097.         } else if (ttypedefns[i].strgetter) {
  1098.             TYPEPROP(ttypes, t, ttypedefns, i, char *) =
  1099.               c_string(eval(val));
  1100.         } else {
  1101.             TYPEPROP(ttypes, t, ttypedefns, i, Obj *) = val;
  1102.         }
  1103.         found = TRUE;
  1104.         break;
  1105.         }
  1106.     }
  1107.     if (!found) unknown_property("terrain type", t_type_name(t), propname);
  1108.     }
  1109.     /* Recalculate the count of subtypes. */
  1110.     count_terrain_subtypes();
  1111. }
  1112.  
  1113. /* Fill in a table. */
  1114.  
  1115. static void
  1116. interp_table(form)
  1117. Obj *form;
  1118. {
  1119.     int i, found, lim1, lim2, reset = TRUE;
  1120.     Obj *formsym = cadr(form), *body = cddr(form);
  1121.     char *tablename;
  1122.  
  1123.     TYPECHECK(symbolp, formsym, "table name not a symbol");
  1124.     tablename = c_string(formsym);
  1125.     found = FALSE;
  1126.     for (i = 0; tabledefns[i].name != NULL; ++i) {
  1127.     if (strcmp(tablename, tabledefns[i].name) == 0) {
  1128.         if (match_keyword(car(body), K_ADD)) {
  1129.         body = cdr(body);
  1130.         reset = FALSE;
  1131.         }
  1132.         allocate_table(i, reset);
  1133.         add_to_table(formsym, i, body, FALSE);
  1134.         found = TRUE;
  1135.         break;
  1136.     }
  1137.     }
  1138.     if (!found) read_warning( "Undefined table `%s'", tablename);
  1139. }
  1140.  
  1141. /* Given a table and a list of value-setting clauses, fill in the table. */
  1142.  
  1143. #define INDEXP(typ, x) \
  1144.   ((typ == UTYP) ? utypep(x) : ((typ == MTYP) ? mtypep(x) : ttypep(x)))
  1145.  
  1146. #define nonlist(x) (!consp(x) && x != lispnil)
  1147.  
  1148. #define CHECK_INDEX_1(tbl, x)  \
  1149.   if (!INDEXP(tabledefns[tbl].index1, (x))) {  \
  1150.       read_warning("index 1 to table %s has wrong type",  \
  1151.            tabledefns[tbl].name);  \
  1152.       return;  \
  1153.   }
  1154.  
  1155. #define CHECK_INDEX_2(tbl, x)  \
  1156.   if (!INDEXP(tabledefns[tbl].index2, (x))) {  \
  1157.       read_warning("index 2 to table %s has wrong type",  \
  1158.            tabledefns[tbl].name);  \
  1159.       return;  \
  1160.   }
  1161.  
  1162. #define CHECK_VALUE(tbl, x)  \
  1163.   if (!numberp(x)) {  \
  1164.       read_warning("value for table %s is not a number",  \
  1165.            tabledefns[tbl].name);  \
  1166.       return;  \
  1167.   }
  1168.  
  1169. #define CHECK_LISTS(tablename, lis1, lis2)  \
  1170.   if (consp(lis2)  \
  1171.       && !list_lengths_match(lis1, lis2, "table", tablename))  {  \
  1172.       return;  \
  1173.   }
  1174.  
  1175.  
  1176. static void
  1177. add_to_table(tablename, tbl, clauses, init)
  1178. int tbl, init;
  1179. Obj *tablename, *clauses;
  1180. {
  1181.     int i, num, lim1, lim2;
  1182.     Obj *clause, *indexes1, *indexes2, *values;
  1183.  
  1184.     lim1 = numtypes_from_index_type(tabledefns[tbl].index1);
  1185.     lim2 = numtypes_from_index_type(tabledefns[tbl].index2);
  1186.     for ( ; clauses != lispnil; clauses = cdr(clauses)) {
  1187.     clause = car(clauses);
  1188.     switch (clause->type) {
  1189.       case SYMBOL:
  1190.         clause = eval_symbol(clause);
  1191.         TYPECHECK(numberp, clause, "table clause does not eval to number");
  1192.         /* Now treat it as a number. */
  1193.       case NUMBER:
  1194.         /* a constant value - blast over everything */
  1195.         num = c_number(clause);
  1196.         for (i = 0; i < lim1 * lim2; ++i) {
  1197.         (*(tabledefns[tbl].table))[i] = num;
  1198.         }
  1199.         break;
  1200.       case CONS:
  1201.         /* Evaluate the three parts of a clause. */
  1202.         indexes1 = eval(car(clause));
  1203.         indexes2 = eval(cadr(clause));
  1204.         values = eval(caddr(clause));
  1205.         interp_one_clause(tablename, tbl, lim1, lim2,
  1206.                   indexes1, indexes2, values);
  1207.         break;
  1208.       case STRING:
  1209.         break; /* error? */
  1210.       default:
  1211.         /* who knows? */
  1212.         break;
  1213.     }
  1214.     }
  1215. }
  1216.  
  1217. static void
  1218. interp_one_clause(tablename, tbl, lim1, lim2, indexes1, indexes2, values)
  1219. Obj *tablename, *indexes1, *indexes2, *values;
  1220. int tbl, lim1, lim2;
  1221. {
  1222.     int i, j, num;
  1223.     Obj *tmp1, *tmp2, *value, *subvalue;
  1224.  
  1225.     if (nonlist(indexes1)) {
  1226.     CHECK_INDEX_1(tbl, indexes1);
  1227.     i = c_number(indexes1);
  1228.     if (nonlist(indexes2) ) {
  1229.         CHECK_INDEX_2(tbl, indexes2);
  1230.         j = c_number(indexes2);
  1231.         value = values;
  1232.         CHECK_VALUE(tbl, value);
  1233.         num = c_number(value);
  1234.         (*(tabledefns[tbl].table))[lim2 * i + j] = num;
  1235.     } else {
  1236.         CHECK_LISTS(tablename, indexes2, values);
  1237.         for (tmp2 = indexes2; tmp2 != lispnil; tmp2 = cdr(tmp2)) {
  1238.         CHECK_INDEX_2(tbl, car(tmp2));
  1239.         j = c_number(car(tmp2));
  1240.         value = (consp(values) ? car(values) : values);
  1241.         CHECK_VALUE(tbl, value);
  1242.         num = c_number(value);
  1243.         (*(tabledefns[tbl].table))[lim2 * i + j] = num;
  1244.         if (consp(values)) values = cdr(values);
  1245.         }
  1246.     }
  1247.     } else {
  1248.     CHECK_LISTS(tablename, indexes1, values);
  1249.     for (tmp1 = indexes1; tmp1 != lispnil; tmp1 = cdr(tmp1)) {
  1250.         CHECK_INDEX_1(tbl, car(tmp1));
  1251.         i = c_number(car(tmp1));
  1252.         value = (consp(values) ? car(values) : values);
  1253.         if (nonlist(indexes2)) {
  1254.         CHECK_INDEX_2(tbl, indexes2);
  1255.         j = c_number(indexes2);
  1256.         CHECK_VALUE(tbl, value);
  1257.         num = c_number(value);
  1258.         (*(tabledefns[tbl].table))[lim2 * i + j] = num;
  1259.         } else {
  1260.         CHECK_LISTS(tablename, indexes2, value);
  1261.         for (tmp2 = indexes2; tmp2 != lispnil; tmp2 = cdr(tmp2)) {
  1262.             CHECK_INDEX_2(tbl, car(tmp2));
  1263.             j = c_number(car(tmp2));
  1264.             subvalue = (consp(value) ? car(value) : value);
  1265.             CHECK_VALUE(tbl, subvalue);
  1266.             num = c_number(subvalue);
  1267.             (*(tabledefns[tbl].table))[lim2 * i + j] = num;
  1268.             if (consp(value)) value = cdr(value);
  1269.         }
  1270.         }
  1271.         if (consp(values)) values = cdr(values);
  1272.     }
  1273.     }
  1274. }
  1275.  
  1276. /* Set the binding of an existing known variable. */
  1277.  
  1278. static void
  1279. interp_variable(form, isnew)
  1280. Obj *form;
  1281. int isnew;
  1282. {
  1283.     Obj *var = cadr(form);
  1284.     Obj *val = eval(caddr(form));
  1285.     char *name;
  1286.  
  1287.     if (!symbolp(var)) {
  1288.     read_warning("Can't set a non-symbol!");
  1289.     return;
  1290.     }
  1291.     name = c_string(var);
  1292.  
  1293.   if (isnew) {
  1294.     if (boundp(var)) {
  1295.     read_warning("Symbol `%s' has been bound already, overwriting", name);
  1296.     }
  1297.     setq(var, val);
  1298.   } else {
  1299.  
  1300. #undef  DEF_VAR_I
  1301. #define DEF_VAR_I(STR,fname,SETFNAME,doc,var,lo,dflt,hi)  \
  1302.     if (strcmp(name, STR) == 0)  \
  1303.       { SETFNAME(c_number(val));  return; }
  1304. #undef  DEF_VAR_S
  1305. #define DEF_VAR_S(STR,fname,SETFNAME,doc,var,dflt)  \
  1306.     if (strcmp(name, STR) == 0)  \
  1307.       { SETFNAME(c_string(val));  return; }
  1308. #undef  DEF_VAR_L
  1309. #define DEF_VAR_L(STR,fname,SETFNAME,doc,var,dflt)  \
  1310.     if (strcmp(name, STR) == 0)  \
  1311.       { SETFNAME(val);  return; }
  1312.  
  1313. #include "gvar.def"
  1314.  
  1315.     /* Try as a random symbol. */
  1316.     if (boundp(var)) {
  1317.     setq(var, val);
  1318.     return;
  1319.     }
  1320.     /* Out of luck. */
  1321.     read_warning("Can't set unknown global named `%s'", name);
  1322.   }
  1323. }
  1324.  
  1325. static void
  1326. undefine_variable(form)
  1327. Obj *form;
  1328. {
  1329.     Obj *var = cadr(form);
  1330.  
  1331.     if (!symbolp(var)) {
  1332.     read_warning("Can't undefine a non-symbol!");
  1333.     return;
  1334.     }
  1335.     makunbound(var);
  1336. }
  1337.  
  1338. /* General function to augment types. */
  1339.  
  1340. static void
  1341. add_properties(form)
  1342. Obj *form;
  1343. {
  1344.    Obj *types = eval(cadr(form));
  1345.    Obj *prop = caddr(form);
  1346.    Obj *values = eval(cadr(cddr(form)));
  1347.  
  1348.    if (utypep(types) || (consp(types) && utypep(car(types)))) {
  1349.        add_to_utypes(types, prop, values);
  1350.    } else if (mtypep(types) || (consp(types) && mtypep(car(types)))) {
  1351.        add_to_mtypes(types, prop, values);
  1352.    } else if (ttypep(types) || (consp(types) && ttypep(car(types)))) {
  1353.        add_to_ttypes(types, prop, values);
  1354.    } else {
  1355.        if (readerrbuf == NULL)
  1356.      readerrbuf = (char *) xmalloc(BUFSIZE);
  1357.        sprintlisp(readerrbuf, form);
  1358.        read_warning("No types to add to in `%s'", readerrbuf);
  1359.    }
  1360. }
  1361.  
  1362. /* Compare a list of types with a list of values, complain if
  1363.    they don't match up. */
  1364.  
  1365. static int
  1366. list_lengths_match(types, values, formtype, form)
  1367. Obj *types, *values, *form;
  1368. char *formtype;
  1369. {
  1370.     if (length(types) != length(values)) {
  1371.     sprintlisp(spbuf, form);
  1372.     read_warning("Lists of differing lengths (%d vs %d) in %s `%s'",
  1373.              length(types), length(values), formtype, spbuf);
  1374.     return FALSE;
  1375.     }
  1376.     return TRUE;
  1377. }
  1378.  
  1379. static void
  1380. add_to_utypes(types, prop, values)
  1381. Obj *types, *prop, *values;
  1382. {
  1383.     char *propname = c_string(prop);
  1384.     Obj *lis1, *lis2;
  1385.  
  1386.     if (utypep(types)) {
  1387.     set_utype_property(types->v.num, propname, values);
  1388.     } else if (consp(types)) {
  1389.     if (consp(values)) {
  1390.         if (!list_lengths_match(types, values, "utype property", prop)) return;
  1391.         for (lis1 = types, lis2 = values;
  1392.          lis1 != lispnil && lis2 != lispnil;
  1393.          lis1 = cdr(lis1), lis2 = cdr(lis2)) {
  1394.         TYPECHECK(utypep, car(lis1), "not a unit type");
  1395.         if (!set_utype_property(car(lis1)->v.num, propname, car(lis2)))
  1396.           break;
  1397.         }
  1398.     } else {
  1399.         for (lis1 = types; lis1 != lispnil; lis1 = cdr(lis1)) {
  1400.         TYPECHECK(utypep, car(lis1), "not a unit type");
  1401.         if (!set_utype_property(car(lis1)->v.num, propname, values))
  1402.           break;
  1403.         }
  1404.     }
  1405.     }
  1406. }
  1407.  
  1408. static void
  1409. add_to_mtypes(types, prop, values)
  1410. Obj *types, *prop, *values;
  1411. {
  1412.     Obj *lis1, *lis2;
  1413.  
  1414.     if (mtypep(types)) {
  1415.     fill_in_mtype(types->v.num,
  1416.               cons(cons(prop, cons(values, lispnil)), lispnil));
  1417.     } else if (consp(types)) {
  1418.     if (consp(values)) {
  1419.         if (!list_lengths_match(types, values, "mtype property", prop))
  1420.           return;
  1421.         for (lis1 = types, lis2 = values;
  1422.          lis1 != lispnil && lis2 != lispnil;
  1423.          lis1 = cdr(lis1), lis2 = cdr(lis2)) {
  1424.         TYPECHECK(mtypep, car(lis1), "not a unit type");
  1425.         fill_in_mtype(car(lis1)->v.num,
  1426.                   cons(cons(prop, cons(car(lis2), lispnil)),
  1427.                    lispnil));
  1428.         }
  1429.     } else {
  1430.         for (lis1 = types; lis1 != lispnil; lis1 = cdr(lis1)) {
  1431.         TYPECHECK(mtypep, car(lis1), "not a unit type");
  1432.         fill_in_mtype(car(lis1)->v.num,
  1433.                   cons(cons(prop, cons(values, lispnil)),
  1434.                    lispnil));
  1435.         }
  1436.     }
  1437.     }
  1438. }
  1439.  
  1440. static void
  1441. add_to_ttypes(types, prop, values)
  1442. Obj *types, *prop, *values;
  1443. {
  1444.     Obj *lis1, *lis2;
  1445.  
  1446.     if (ttypep(types)) {
  1447.     fill_in_ttype(types->v.num,
  1448.               cons(cons(prop, cons(values, lispnil)), lispnil));
  1449.     } else if (consp(types)) {
  1450.     if (consp(values)) {
  1451.         if (!list_lengths_match(types, values, "ttype property", prop)) return;
  1452.         for (lis1 = types, lis2 = values;
  1453.          lis1 != lispnil && lis2 != lispnil;
  1454.          lis1 = cdr(lis1), lis2 = cdr(lis2)) {
  1455.         TYPECHECK(ttypep, car(lis1), "not a terrain type");
  1456.         fill_in_ttype(car(lis1)->v.num,
  1457.                   cons(cons(prop, cons(car(lis2), lispnil)),
  1458.                    lispnil));
  1459.         }
  1460.     } else {
  1461.         for (lis1 = types; lis1 != lispnil; lis1 = cdr(lis1)) {
  1462.         TYPECHECK(ttypep, car(lis1), "not a terrain type");
  1463.         fill_in_ttype(car(lis1)->v.num,
  1464.                   cons(cons(prop, cons(values, lispnil)),
  1465.                    lispnil));
  1466.         }
  1467.     }
  1468.     }
  1469. }
  1470.  
  1471. #endif /* n SPECIAL */
  1472.  
  1473. /* Interpret a world-specifying form. */
  1474.  
  1475. static void
  1476. interp_world(form)
  1477. Obj *form;
  1478. {
  1479.     int numval;
  1480.     Obj *props, *bdg, *propval;
  1481.     char *propname;
  1482.  
  1483.     props = cdr(form);
  1484.     if (symbolp(car(props))) {
  1485.     /* This is the id of the world (eventually). */
  1486.     props = cdr(props);
  1487.     }
  1488.     if (numberp(car(props))) {
  1489.         set_world_circumference(c_number(car(props)), TRUE);
  1490.     props = cdr(props);
  1491.     }
  1492.     for ( ; props != lispnil; props = cdr(props)) {
  1493.     bdg = car(props);
  1494.     PARSE_PROPERTY(bdg, propname, propval);
  1495.     if (numberp(propval))
  1496.       numval = c_number(propval);
  1497.     switch (keyword_code(propname)) {
  1498.       case K_CIRCUMFERENCE:
  1499.         world.circumference = numval;
  1500.         break;
  1501.       case K_DAY_LENGTH:
  1502.         world.daylength = numval;
  1503.         break;
  1504.       case K_YEAR_LENGTH:
  1505.         world.yearlength = numval;
  1506.         break;
  1507.       case K_AXIAL_TILT:
  1508.         world.axialtilt = numval;
  1509.         break;
  1510.       default:
  1511.         unknown_property("world", "", propname);
  1512.     }
  1513.     }
  1514. }
  1515.  
  1516. /* Only one area, of fixed size.  Created anew if shape/size is supplied, else
  1517.    just modified. */
  1518.  
  1519. static void
  1520. interp_area(form)
  1521. Obj *form;
  1522. {
  1523.     int newarea = FALSE, newwidth = 0, newheight = 0, recheck = FALSE, numval;
  1524.     Obj *props, *subprop, *bdg, *propval, *rest;
  1525.     char *propname;
  1526.  
  1527.     props = cdr(form);
  1528.     /* (eventually this will be an id or name) */
  1529.     if (symbolp(car(props))) {
  1530.     props = cdr(props);
  1531.     newarea = TRUE;
  1532.     }
  1533.     /* Collect the width of the area. */
  1534.     if (numberp(car(props))) {
  1535.     newwidth = newheight = c_number(car(props));
  1536.         if (area.fullwidth == 0)
  1537.       newarea = TRUE;
  1538.     if (area.fullwidth > 0 && area.fullwidth != newwidth)
  1539.       read_warning("weird areas - %d vs %d", area.fullwidth, newwidth);
  1540.     props = cdr(props);
  1541.     }
  1542.     /* Collect the height of the area. */
  1543.     if (numberp(car(props))) {
  1544.     newheight = c_number(car(props));
  1545.         if (area.fullheight == 0)
  1546.       newarea = TRUE;
  1547.     if (area.fullheight > 0 && area.fullheight != newheight)
  1548.       read_warning("weird areas - %d vs %d", area.fullheight, newheight);
  1549.     props = cdr(props);
  1550.     }
  1551.     /* See if we're restricting ourselves to a piece of a larger area. */
  1552.     if (consp(car(props))
  1553.         && match_keyword(car(car(props)), K_RESTRICT)) {
  1554.         subprop = cdr(car(props));
  1555.         if (numberp(car(subprop))) {
  1556.         area.fullwidth = c_number(car(subprop));
  1557.         subprop = cdr(subprop);
  1558.         TYPECHECK(numberp, car(subprop), "restriction parm not a number");
  1559.         area.fullheight = c_number(car(subprop));
  1560.         subprop = cdr(subprop);
  1561.         TYPECHECK(numberp, car(subprop), "restriction parm not a number");
  1562.         area.fullx = c_number(car(subprop));
  1563.         subprop = cdr(subprop);
  1564.         TYPECHECK(numberp, car(subprop), "restriction parm not a number");
  1565.         area.fully = c_number(car(subprop));
  1566.         } else if (match_keyword(car(subprop), K_RESET)) {
  1567.         area.fullwidth = area.fullheight = 0;
  1568.         area.fullx = area.fully = 0;
  1569.         } else {
  1570.         syntax_error(car(props), "not 4 numbers or \"reset\"");
  1571.         return;
  1572.         }
  1573.     props = cdr(props);        
  1574.     }
  1575.     /* If this is setting the area's shape for the first time,
  1576.        actually do it. */
  1577.     if (newarea)
  1578.       set_area_shape(newwidth, newheight, TRUE);
  1579.     for ( ; props != lispnil; props = cdr(props)) {
  1580.     bdg = car(props);
  1581.     PARSE_PROPERTY(bdg, propname, propval);
  1582.     if (numberp(propval))
  1583.       numval = c_number(propval);
  1584.     rest = cdr(bdg);
  1585.     switch (keyword_code(propname)) {
  1586.       case K_WIDTH:
  1587.         area.width = numval;
  1588.         recheck = TRUE;
  1589.         break;
  1590.       case K_HEIGHT:
  1591.         area.height = numval;
  1592.         recheck = TRUE;
  1593.         break;
  1594.       case K_LATITUDE:
  1595.         area.latitude = numval;
  1596.         break;
  1597.       case K_LONGITUDE:
  1598.         area.longitude = numval;
  1599.         break;
  1600.       case K_CELL_WIDTH:
  1601.         area.cellwidth = numval;
  1602.         break;
  1603.       case K_TERRAIN:
  1604.         fill_in_terrain(rest);
  1605.         break;
  1606.       case K_AUX_TERRAIN:
  1607.         fill_in_aux_terrain(rest);
  1608.         break;
  1609.       case K_PEOPLE_SIDES:
  1610.         fill_in_people_sides(rest);
  1611.         break;
  1612.       case K_FEATURES:
  1613.         fill_in_features(rest);
  1614.         break;
  1615.       case K_ELEVATIONS:
  1616.         fill_in_elevations(rest);
  1617.         break;
  1618.       case K_MATERIAL:
  1619.         fill_in_cell_material(rest);
  1620.         break;
  1621.       case K_TEMPERATURES:
  1622.         fill_in_temperatures(rest);
  1623.         break;
  1624.       case K_WINDS:
  1625.         fill_in_winds(rest);
  1626.         break;
  1627.       case K_CLOUDS:
  1628.         fill_in_clouds(rest);
  1629.         break;
  1630.       case K_CLOUD_BOTTOMS:
  1631.         fill_in_cloud_bottoms(rest);
  1632.         break;
  1633.       case K_CLOUD_HEIGHTS:
  1634.         fill_in_cloud_heights(rest);
  1635.         break;
  1636.       default:
  1637.         unknown_property("area", "", propname);
  1638.     }
  1639.     }
  1640.     /* This rechecks the width and height if they were set via properties. */
  1641.     if (recheck)
  1642.       set_area_shape(area.width, area.height, TRUE);
  1643. }
  1644.  
  1645. /* The general plan of reading is similar for all layers - create a blank
  1646.    layer if none allocated, then call read_layer and pass a function that will
  1647.    actually put a value into a cell of the layer.  We need to define those
  1648.    functions because most of the setters are macros, and because we can do
  1649.    some extra error checking. */
  1650.  
  1651. /* Read the area terrain. */
  1652.  
  1653. static void
  1654. fill_in_terrain(contents)
  1655. Obj *contents;
  1656. {
  1657.     /* We must have some terrain types or we're going to lose bigtime. */
  1658.     if (numttypes == 0)
  1659.       load_default_game();
  1660.     numbadterrain = 0;
  1661.     /* Make sure the terrain layer exists. */
  1662.     if (!terrain_defined())
  1663.       allocate_area_terrain();
  1664.     read_layer(contents, fn_set_terrain_at);
  1665.     if (numbadterrain > 0) {
  1666.     read_warning("%d occurrences of unknown terrain in all",
  1667.              numbadterrain);
  1668.     }
  1669. }
  1670.  
  1671. /* Read a layer of auxiliary terrain. */
  1672.  
  1673. static void
  1674. fill_in_aux_terrain(contents)
  1675. Obj *contents;
  1676. {
  1677.     int t;
  1678.     Obj *typesym = car(contents), *typeval;
  1679.  
  1680.     if (symbolp(typesym) && ttypep(typeval = eval(typesym))) {
  1681.     t = c_number(typeval);
  1682.     contents = cdr(contents);
  1683.     /* Make sure aux terrain space exists, but don't overwrite. */
  1684.     allocate_area_aux_terrain(t);
  1685.     tmpttype = t;
  1686.     read_layer(contents, fn_set_aux_terrain_at);
  1687.     /* Ensure that borders and connections have all their bits
  1688.        correctly set. */
  1689.     patch_linear_terrain(t);
  1690.     } else {
  1691.     /* not a valid aux terrain type */
  1692.     }
  1693. }
  1694.  
  1695. static void
  1696. fill_in_people_sides(contents)
  1697. Obj *contents;
  1698. {
  1699.     /* Make sure the people sides layer exists. */
  1700.     allocate_area_people_sides();
  1701.     read_layer(contents, fn_set_people_side_at);
  1702. }
  1703.  
  1704. /* This should recompute size etc of all these features too. */
  1705.  
  1706. static void
  1707. fill_in_features(contents)
  1708. Obj *contents;
  1709. {
  1710.     int fid, fidnext = 1;
  1711.     Obj *featspec, *flist;
  1712.     Feature *feat;
  1713.  
  1714.     init_features();
  1715.     for (flist = car(contents); flist != lispnil; flist = cdr(flist)) {
  1716.     featspec = car(flist);
  1717.     fid = 0;
  1718.     if (numberp(car(featspec))) {
  1719.         fid = c_number(car(featspec));
  1720.         fidnext = max(fid + 1, fidnext);
  1721.         featspec = cdr(featspec);
  1722.     }
  1723.     feat = create_feature(c_string(car(featspec)),
  1724.                   c_string(cadr(featspec)));
  1725.     if (fid == 0)
  1726.       fid = fidnext++;
  1727.     feat->id = fid;
  1728.     }
  1729.     read_layer(cdr(contents), fn_set_raw_feature_at);
  1730. }
  1731.  
  1732. static void
  1733. fill_in_elevations(contents)
  1734. Obj *contents;
  1735. {
  1736.     /* Make sure the elevation layer exists. */
  1737.     allocate_area_elevations();
  1738.     read_layer(contents, fn_set_elevation_at);
  1739. }
  1740.  
  1741. static void
  1742. fill_in_cell_material(contents)
  1743. Obj *contents;
  1744. {
  1745.     int m;
  1746.     Obj *typesym = car(contents), *typeval;
  1747.  
  1748.     if (symbolp(typesym) && mtypep(typeval = eval(typesym))) {
  1749.     m = c_number(typeval);
  1750.     contents = cdr(contents);
  1751.     /* Make sure this material layer exists. */
  1752.     allocate_area_material(m);
  1753.     tmpmtype = m;
  1754.     read_layer(contents, fn_set_material_at);
  1755.     } else {
  1756.     /* not a valid material type spec, should warn */
  1757.     }
  1758. }
  1759.  
  1760. static void
  1761. fill_in_temperatures(contents)
  1762. Obj *contents;
  1763. {
  1764.     /* Make sure the temperature layer exists. */
  1765.     allocate_area_temperatures();
  1766.     read_layer(contents, fn_set_temperature_at);
  1767. }
  1768.  
  1769. static void
  1770. fill_in_winds(contents)
  1771. Obj *contents;
  1772. {
  1773.     /* Make sure the winds layer exists. */
  1774.     allocate_area_winds();
  1775.     read_layer(contents, fn_set_raw_wind_at);
  1776. }
  1777.  
  1778. static void
  1779. fill_in_clouds(contents)
  1780. Obj *contents;
  1781. {
  1782.     /* Make sure the clouds layer exists. */
  1783.     allocate_area_clouds();
  1784.     read_layer(contents, fn_set_raw_cloud_at);
  1785. }
  1786.  
  1787. static void
  1788. fill_in_cloud_bottoms(contents)
  1789. Obj *contents;
  1790. {
  1791.     /* Make sure the cloud bottoms layer exists. */
  1792.     allocate_area_cloud_bottoms();
  1793.     read_layer(contents, fn_set_raw_cloud_bottom_at);
  1794. }
  1795.  
  1796. static void
  1797. fill_in_cloud_heights(contents)
  1798. Obj *contents;
  1799. {
  1800.     /* Make sure the cloud heights layer exists. */
  1801.     allocate_area_cloud_heights();
  1802.     read_layer(contents, fn_set_raw_cloud_height_at);
  1803. }
  1804.  
  1805. /* Interpret a side spec. */
  1806.  
  1807. static void
  1808. interp_side(form, side)
  1809. Obj *form;
  1810. Side *side;
  1811. {
  1812.     int id = -1;
  1813.     Obj *ident = lispnil, *props = cdr(form);
  1814.  
  1815.     /* See if there's an optional side identifier and pick it off. */
  1816.     if (props != lispnil && !consp(car(props))) {
  1817.     ident = car(props);
  1818.     props = cdr(props);
  1819.     }
  1820.     if (numberp(ident)) {
  1821.     id = c_number(ident);
  1822.     side = side_n(id);
  1823.     } else {
  1824.     /* We want to create a new side. */
  1825.     }
  1826.     if (side == NULL) {
  1827.     side = create_side();
  1828.     }
  1829.     if (id >= 0) {
  1830.         /* (should worry about id conflicts) */
  1831.         side->id = id;
  1832.     }
  1833.     /* Apply the current side defaults first. */
  1834.     fill_in_side(side, side_defaults, FALSE);
  1835.     /* Now fill in from the explicitly specified properties. */
  1836.     fill_in_side(side, props, FALSE);
  1837.     Dprintf("  Got side %s\n", side_desig(side));
  1838. }
  1839.  
  1840. /* Given a side, fill in some of its properties. */
  1841.  
  1842. #if 0
  1843.         if (userdata)
  1844.           { read_warning("No permission to set property");  break; }
  1845. #endif
  1846.  
  1847. void
  1848. fill_in_side(side, props, userdata)
  1849. Side *side;
  1850. Obj *props;
  1851. int userdata;
  1852. {
  1853.     int numval = 0;
  1854.     char *propname, *strval = NULL;
  1855.     Obj *bdg, *rest, *propval;
  1856.  
  1857.     for (; props != lispnil; props = cdr(props)) {
  1858.     bdg = car(props);
  1859.     PARSE_PROPERTY(bdg, propname, propval);
  1860.     if (symbolp(propval))
  1861.       propval = eval(propval);
  1862.     if (numberp(propval))
  1863.       numval = c_number(propval);
  1864.     if (stringp(propval))
  1865.       strval = c_string(propval);
  1866.     rest = cdr(bdg);
  1867.     /* (should check if user-settable property by looking at keyword flag) */
  1868.     switch (keyword_code(propname)) {
  1869.       case K_NAME:
  1870.         check_name_uniqueness(side, strval, "name");
  1871.         side->name = strval;
  1872.         break;
  1873.       case K_LONG_NAME:
  1874.         check_name_uniqueness(side, strval, "long name");
  1875.         side->longname = strval;
  1876.         break;
  1877.       case K_SHORT_NAME:
  1878.         check_name_uniqueness(side, strval, "short name");
  1879.         side->shortname = strval;
  1880.         break;
  1881.       case K_NOUN:
  1882.         check_name_uniqueness(side, strval, "noun");
  1883.         side->noun = strval;
  1884.         break;
  1885.       case K_PLURAL_NOUN:
  1886.         check_name_uniqueness(side, strval, "plural noun");
  1887.         side->pluralnoun = strval;
  1888.         break;
  1889.       case K_ADJECTIVE:
  1890.         check_name_uniqueness(side, strval, "adjective");
  1891.         side->adjective = strval;
  1892.         break;
  1893.           /* Several synonyms are allowed for specifying colors. */
  1894.       case K_COLOR:
  1895.         side->colorscheme = strval;
  1896.         break;
  1897.       case K_EMBLEM_NAME:
  1898.         side->emblemname = strval;
  1899.         break;
  1900.       case K_UNIT_NAMERS:
  1901.         /* Allocate space if not already done so. */
  1902.         if (side->unitnamers == NULL)
  1903.           side->unitnamers = (char **) xmalloc(numutypes * sizeof(char *));
  1904.         merge_unit_namers(side, rest);
  1905.         break;
  1906.       case K_FEATURE_NAMERS:
  1907.         /* (should merge instead of bashing) */
  1908.         side->featurenamers = rest;
  1909.         break;
  1910.       case K_TASK_LIMIT:
  1911.         side->tasklimit = numval;
  1912.         break;
  1913.       case K_RESPECT_NEUTRALITY:
  1914.         side->respectneutrality = numval;
  1915.         break;
  1916.       case K_REAL_TIMEOUT:
  1917.         side->realtimeout = numval;
  1918.         break;
  1919.       case K_WILLING_TO_DRAW:
  1920.         side->willingtodraw = numval;
  1921.         break;
  1922.       case K_TRUSTS:
  1923.         interp_side_value_list(side->trusts, rest);
  1924.         break;
  1925.       case K_TRADES:
  1926.         interp_side_value_list(side->trades, rest);
  1927.         break;
  1928.       case K_DOCTRINES:
  1929.         read_utype_doctrine(side, cadr(bdg), cddr(bdg));
  1930.         break;
  1931.       case K_DOCTRINES_LOCKED:
  1932.         side->doctrineslocked = numval;
  1933.         break;
  1934.       case K_UI_DATA:
  1935.         /* should pass to interface routine */
  1936.         break;
  1937.       case K_NAMES_LOCKED:
  1938.         side->nameslocked = numval;
  1939.         break;
  1940.       case K_CLASS:
  1941.         side->sideclass = strval;
  1942.         break;
  1943.       case K_ACTIVE:
  1944.         side->ingame = numval;
  1945.         break;
  1946.       case K_PRIORITY:
  1947.         side->priority = numval;
  1948.         break;
  1949.       case K_STATUS:
  1950.         side->status = numval;
  1951.         break;
  1952.       case K_PLAYER:
  1953.         side->playerid = numval;
  1954.         break;
  1955.       case K_ADVANTAGE:
  1956.         side->advantage = numval;
  1957.         break;
  1958.       case K_ADVANTAGE_MIN:
  1959.         side->minadvantage = numval;
  1960.         break;
  1961.       case K_ADVANTAGE_MAX:
  1962.         side->maxadvantage = numval;
  1963.         break;
  1964.       case K_CONTROLLED_BY:
  1965.         side->controlledbyid = numval;
  1966.         break;
  1967.       case K_SELF_UNIT:
  1968.         side->selfunitid = numval;
  1969.         break;
  1970.       case K_TURN_TIME_USED:
  1971.         side->turntimeused = numval;
  1972.         break;
  1973.       case K_TOTAL_TIME_USED:
  1974.         side->totaltimeused = numval;
  1975.         break;
  1976.       case K_TIMEOUTS:
  1977.         side->timeouts = numval;
  1978.         break;
  1979.       case K_TIMEOUTS_USED:
  1980.         side->timeoutsused = numval;
  1981.         break;
  1982.       case K_FINISHED_TURN:
  1983.         side->finishedturn = numval;
  1984.         break;
  1985.       case K_START_WITH:
  1986.         if (side->startwith == NULL)
  1987.           side->startwith = (short *) xmalloc(numutypes * sizeof(short));
  1988.         interp_utype_value_list(side->startwith, rest);
  1989.         break;
  1990.       case K_NEXT_NUMBERS:
  1991.         if (side->counts == NULL)
  1992.           side->counts = (short *) xmalloc(numutypes * sizeof(short));
  1993.         interp_utype_value_list(side->counts, rest);
  1994.         break;
  1995.       case K_TECH:
  1996.         if (side->tech == NULL)
  1997.           side->tech = (short *) xmalloc(numutypes * sizeof(short));
  1998.         interp_utype_value_list(side->tech, rest);
  1999.         break;
  2000.       case K_INIT_TECH:
  2001.         if (side->inittech == NULL)
  2002.           side->inittech = (short *) xmalloc(numutypes * sizeof(short));
  2003.         interp_utype_value_list(side->inittech, rest);
  2004.         break;
  2005.       case K_SCORES:
  2006.         /* This will be patched up later, after scorekeepers exist. */
  2007.         side->scores = (short *) rest;
  2008.         break;
  2009.       case K_TERRAIN_VIEW:
  2010.         read_terrain_view(side, rest);
  2011.         break;
  2012.       case K_UNIT_VIEW:
  2013.         read_unit_view(side, rest);
  2014.         break;
  2015.       case K_UNIT_VIEW_DATES:
  2016.         read_unit_view_dates(side, rest);
  2017.         break;
  2018.       case K_AI_DATA:
  2019.         ai_read_state(side, rest);
  2020.         break;
  2021.       default:
  2022.         unknown_property("side", side_desig(side), propname);
  2023.     }
  2024.     }
  2025.     if (side->noun != NULL && side->pluralnoun == NULL) {
  2026.     side->pluralnoun = copy_string(plural_form(side->noun));
  2027.     }
  2028. }
  2029.  
  2030. static void
  2031. check_name_uniqueness(side, str, kind)
  2032. Side *side;
  2033. char *str, *kind;
  2034. {
  2035.     if (name_in_use(side, str)) {
  2036.     init_warning("Side %s `%s' is already in use", kind, str);
  2037.     }
  2038. }
  2039.  
  2040. /* Given a list of (utype str) pairs, set unit namers appropriately. */
  2041.  
  2042. static void
  2043. merge_unit_namers(side, lis)
  2044. Side *side;
  2045. Obj *lis;
  2046. {
  2047.     int u;
  2048.     Obj *rest, *elt, *types, *namer;
  2049.  
  2050.     for (rest = lis; rest != lispnil; rest = cdr(rest)) {
  2051.     elt = car(rest);
  2052.     if (consp(elt)) {
  2053.         types = eval(car(elt));
  2054.         namer = cadr(elt);
  2055.         if (utypep(types) && stringp(namer)) {
  2056.         u = c_number(types);
  2057.         side->unitnamers[u] = c_string(namer);
  2058.         } else {
  2059.         read_warning("garbled unit namer");
  2060.         }
  2061.     } else {
  2062.         /* (should assign to "next" utype?) */
  2063.         read_warning("by-position unit namer not handled");
  2064.     }
  2065.     }
  2066. }
  2067.  
  2068. static void
  2069. interp_side_value_list(arr, lis)
  2070. short *arr;
  2071. Obj *lis;
  2072. {
  2073.     int s = 0;
  2074.     Obj *rest, *head;
  2075.  
  2076.     if (arr == NULL)
  2077.       run_error("null array for side value list?");
  2078.     for (rest = lis; rest != lispnil; rest = cdr(rest)) {
  2079.         head = car(rest);
  2080.     if (numberp(head)) {
  2081.         if (s > g_sides_max())
  2082.           break;
  2083.         arr[s++] = c_number(head);
  2084.     } else if (symbolp(head)) {
  2085.         int s2 = c_number(eval(head));
  2086.  
  2087.         if (between(1, s2, g_sides_max()))
  2088.           arr[s2] = TRUE;
  2089.         else
  2090.           read_warning("bad side spec");
  2091.     } else if (consp(head)) {
  2092.         Obj *sidespec = car(head);
  2093.         int s2, val2 = c_number(cadr(head));
  2094.  
  2095.         if (numberp(sidespec) || symbolp(sidespec)) {
  2096.         s2 = c_number(eval(sidespec));
  2097.  
  2098.             if (between(1, s2, g_sides_max()))
  2099.               arr[s2] = val2;
  2100.             else
  2101.               read_warning("bad side spec");
  2102.         } else if (consp(sidespec)) {
  2103.             read_warning("not implemented");
  2104.         } else {
  2105.             read_warning("not implemented");
  2106.         }
  2107.     } else {
  2108.             read_warning("not implemented");
  2109.     }
  2110.     }
  2111. }
  2112.  
  2113. /* Helper function to init side view from rle encoding. */
  2114.  
  2115. static void
  2116. fn_set_terrain_view(x, y, val)
  2117. int x, y, val;
  2118. {
  2119.     set_terrain_view(tmpside, x, y, val);
  2120. }
  2121.  
  2122. static void
  2123. read_terrain_view(side, contents)
  2124. Side *side;
  2125. Obj *contents;
  2126. {
  2127.     if (g_see_all())
  2128.       return;
  2129.     init_view(side);
  2130.     tmpside = side;
  2131.     read_layer(contents, fn_set_terrain_view);
  2132. }
  2133.  
  2134. static void
  2135. fn_set_unit_view(x, y, val)
  2136. int x, y, val;
  2137. {
  2138.     set_unit_view(tmpside, x, y, val);
  2139. }
  2140.  
  2141. static void
  2142. read_unit_view(side, contents)
  2143. Side *side;
  2144. Obj *contents;
  2145. {
  2146.     if (g_see_all())
  2147.       return;
  2148.     init_view(side);
  2149.     tmpside = side;
  2150.     read_layer(contents, fn_set_unit_view);
  2151. }
  2152.  
  2153. static void
  2154. fn_set_unit_view_date(x, y, val)
  2155. int x, y, val;
  2156. {
  2157.     set_unit_view_date(tmpside, x, y, val);
  2158. }
  2159.  
  2160. static void
  2161. read_unit_view_dates(side, contents)
  2162. Side *side;
  2163. Obj *contents;
  2164. {
  2165.     if (g_see_all())
  2166.       return;
  2167.     init_view(side);
  2168.     tmpside = side;
  2169.     read_layer(contents, fn_set_unit_view_date);
  2170. }
  2171.  
  2172. /* Read doctrine info pertaining to a particular unit type. */
  2173.  
  2174. static void
  2175. read_utype_doctrine(side, ulist, props)
  2176. Side *side;
  2177. Obj *ulist, *props;
  2178. {
  2179.     int u = 0;
  2180.     char *propname;
  2181.     Obj *bdg, *val;
  2182.  
  2183.     if (!consp(ulist)) ulist = cons(ulist, lispnil);
  2184.  
  2185.     ulist = eval(ulist);
  2186.     if (numberp(car(ulist))) u = c_number(car(ulist));
  2187.  
  2188.     for (; props != lispnil; props = cdr(props)) {
  2189.     bdg = car(props);
  2190.     PARSE_PROPERTY(bdg, propname, val);
  2191.     switch (keyword_code(propname)) {
  2192.       case K_EVER_ASK_SIDE:
  2193.         u_doctrine(side, u, everaskside) = c_number(val);
  2194.         break;
  2195.       case K_AVOID_BAD_TERRAIN:
  2196.         u_doctrine(side, u, avoidbadterrain) = c_number(val);
  2197.         break;
  2198.       case K_REARM_PERCENT:
  2199.         u_doctrine(side, u, rearm) = c_number(val);
  2200.         break;
  2201.       case K_REPAIR_PERCENT:
  2202.         u_doctrine(side, u, repair) = c_number(val);
  2203.         break;
  2204.       case K_RESUPPLY_PERCENT:
  2205.         u_doctrine(side, u, resupply) = c_number(val);
  2206.         break;
  2207.       case K_LOCKED:
  2208.         u_doctrine(side, u, locked) = c_number(val);
  2209.         break;
  2210.       default:
  2211.         unknown_property("utype doctrine", "", propname);
  2212.     }
  2213.     }
  2214. }
  2215.  
  2216. /* Interpret a form that defines a player. */
  2217.  
  2218. static void
  2219. interp_player(form)
  2220. Obj *form;
  2221. {
  2222.     int id = -1;
  2223.     Obj *ident = lispnil, *props = cdr(form);
  2224.     Player *player = NULL;
  2225.  
  2226.     if (props != lispnil) {
  2227.     if (!consp(car(props))) {
  2228.         ident = car(props);
  2229.         props = cdr(props);
  2230.     }
  2231.     }
  2232.     if (numberp(ident)) {
  2233.     id = c_number(ident);
  2234.     player = find_player(id);
  2235.     }
  2236.     if (player == NULL) {
  2237.     player = add_player();
  2238.     }
  2239.     if (id > 0) player->id = id;
  2240.     fill_in_player(player, props);
  2241.     Dprintf("  Got player %s\n", player_desig(player));
  2242. }
  2243.  
  2244. static void
  2245. fill_in_player(player, props)
  2246. Player *player;
  2247. Obj *props;
  2248. {
  2249.     char *propname, *strval;
  2250.     Obj *bdg, *propval;
  2251.  
  2252.     for (; props != lispnil; props = cdr(props)) {
  2253.     bdg = car(props);
  2254.     PARSE_PROPERTY(bdg, propname, propval);
  2255.     if (stringp(propval)) strval = c_string(propval);
  2256.     switch (keyword_code(propname)) {
  2257.       case K_NAME:
  2258.         player->name = strval;
  2259.         break;
  2260.       case K_CONFIG_NAME:
  2261.         player->configname = strval;
  2262.         break;
  2263.       case K_DISPLAY_NAME:
  2264.         player->displayname = strval;
  2265.         break;
  2266.       case K_AI_TYPE_NAME:
  2267.         player->aitypename = strval;
  2268.         break;
  2269.       case K_INITIAL_ADVANTAGE:
  2270.         player->advantage = c_number(propval);
  2271.         break;
  2272.       case K_PASSWORD:
  2273.         player->password = strval;
  2274.         break;
  2275.       default:
  2276.         unknown_property("player", player_desig(player), propname);
  2277.     }
  2278.     }
  2279.     canonicalize_player(player);
  2280. }
  2281.  
  2282. /* Create and fill in an agreement, as specified by the form. */
  2283.  
  2284. static void
  2285. interp_agreement(form)
  2286. Obj *form;
  2287. {
  2288.     int id = 0;
  2289.     char *propname;
  2290.     Obj *props = cdr(form), *agid, *bdg, *val;
  2291.     Agreement *ag;
  2292.  
  2293.     agid = car(props);
  2294.     if (numberp(agid)) {
  2295.         id = c_number(agid);
  2296.     /* should use the number eventually */
  2297.     props = cdr(props);
  2298.     }
  2299.     if (1 /* must create a new agreement object */) {
  2300.     ag = create_agreement(id);
  2301.     /* Fill in defaults for the slots. */
  2302.     ag->state = draft;  /* default for now */
  2303.     ag->drafters = NOSIDES;
  2304.     ag->proposers = NOSIDES;
  2305.     ag->signers = NOSIDES;
  2306.     ag->willing = NOSIDES;
  2307.     ag->knownto = NOSIDES;
  2308.     }
  2309.     /* Interpret the properties. */
  2310.     for (; props != lispnil; props = cdr(props)) {
  2311.     bdg = car(props);
  2312.     PARSE_PROPERTY(bdg, propname, val);
  2313.     switch (keyword_code(propname)) {
  2314.       case K_TYPE_NAME:
  2315.         ag->typename = c_string(val);
  2316.         break;
  2317.       case K_NAME:
  2318.         ag->name = c_string(val);
  2319.         break;
  2320.       case K_STATE:
  2321.         ag->state = c_number(val);
  2322.         break;
  2323.       case K_TERMS:
  2324.         ag->terms = val;
  2325.         break;
  2326.       case K_DRAFTERS:
  2327.         break;
  2328.       case K_PROPOSERS:
  2329.         break;
  2330.       case K_SIGNERS:
  2331.         break;
  2332.       case K_WILLING_TO_SIGN:
  2333.         break;
  2334.       case K_KNOWN_TO:
  2335.         break;
  2336.       case K_ENFORCEMENT:
  2337.         ag->enforcement = c_number(val);
  2338.         break;
  2339.         break;
  2340.       default:
  2341.         unknown_property("agreement", "", propname);
  2342.     }
  2343.     }
  2344. }
  2345.  
  2346. static void
  2347. interp_unit_defaults(form)
  2348. Obj *form;
  2349. {
  2350.     int numval = 0;
  2351.     int variablelength;
  2352.     Obj *props = form, *bdg, *val;
  2353.     char *propname;
  2354.  
  2355.     if (match_keyword(car(props), K_RESET)) {
  2356.     /* Reset all the tweakable defaults. */
  2357.     uxoffset = 0, uyoffset = 0;
  2358.     default_unit_side_number = -1;
  2359.     default_unit_cp = -1;
  2360.     default_unit_hp = -1;
  2361.     default_unit_cxp = -1;
  2362.     default_unit_z = -1;
  2363.     default_transport_id = -1;
  2364.     default_unit_hook = lispnil;
  2365.     props = cdr(props);
  2366.     }
  2367.     for (; props != lispnil; props = cdr(props)) {
  2368.     bdg = car(props);
  2369.     PARSE_PROPERTY(bdg, propname, val);
  2370.     if (numberp(val))
  2371.       numval = c_number(val);
  2372.     variablelength = FALSE;
  2373.     /* Note that not all unit slots can get default values. */
  2374.     switch (keyword_code(propname)) {
  2375.       case K_AT:
  2376.         uxoffset = numval;
  2377.         uyoffset = c_number(caddr(bdg));
  2378.         variablelength = TRUE;
  2379.         break;
  2380.       case K_S:
  2381.         default_unit_side_number = numval;
  2382.         break;
  2383.       case K_CP:
  2384.         default_unit_cp = numval;
  2385.         break;
  2386.       case K_HP:
  2387.         default_unit_hp = numval;
  2388.         break;
  2389.       case K_CXP:
  2390.         default_unit_cxp = numval;
  2391.         break;
  2392.       case K_M:
  2393.         /* (should fill in) */
  2394.         variablelength = TRUE;
  2395.         break;
  2396.       case K_TP:
  2397.         /* (should fill in) */
  2398.         variablelength = TRUE;
  2399.         break;
  2400.       case K_IN:
  2401.         default_transport_id = numval;
  2402.         break;
  2403.       case K_PLAN:
  2404.         /* (should fill in) */
  2405.         variablelength = TRUE;
  2406.         break;
  2407.       case K_Z:
  2408.         default_unit_z = numval;
  2409.         break;
  2410.       case K_X:
  2411.         default_unit_hook = cdr(bdg);
  2412.         variablelength = TRUE;
  2413.         break;
  2414.       default:
  2415.         unknown_property("unit-defaults", "", propname);
  2416.     }
  2417.     if (!variablelength && cddr(bdg) != lispnil)
  2418.       read_warning("Extra junk in a %s property, ignoring", propname);
  2419.     }
  2420. }
  2421.  
  2422. /* Try to find a unit type named by the string. */
  2423.  
  2424. static int
  2425. utype_from_name(str)
  2426. char *str;
  2427. {
  2428.     int u;
  2429.  
  2430.     for_all_unit_types(u) {
  2431.     if (strcmp(str, u_type_name(u)) == 0
  2432.         || (u_short_name(u) && strcmp(str, u_short_name(u)) == 0)
  2433.         || (u_long_name(u) && strcmp(str, u_long_name(u)) == 0))
  2434.       return u;
  2435.     }
  2436.     /* Try evaluating the symbol too. */
  2437.     if (boundp(intern_symbol(str))
  2438.     && symbol_value(intern_symbol(str))->type == UTYPE) {
  2439.     return symbol_value(intern_symbol(str))->v.num;
  2440.     }
  2441.     return NONUTYPE;
  2442. }
  2443.  
  2444. /* This creates an individual unit and fills in data about it. */
  2445.  
  2446. static void
  2447. interp_unit(form)
  2448. Obj *form;
  2449. {
  2450.     int u, numval = 0, nuid = 0, variablelength, nusn = -1;
  2451.     char *propname;
  2452.     Obj *head = car(form), *props = cdr(form), *bdg, *val;
  2453.     Unit *unit, *unit2;
  2454.     extern int nextid;
  2455.  
  2456.     /* We must have some unit types or we're screwed. */
  2457.     if (numutypes == 0)
  2458.       load_default_game();
  2459.     Dprintf("Reading a unit from ");
  2460.     Dprintlisp(form);
  2461.     Dprintf("\n");
  2462.     if (symbolp(head)) {
  2463.     u = utype_from_name(c_string(head));
  2464.          if (u != NONUTYPE) {
  2465.         unit = create_unit(u, FALSE);
  2466.         if (unit == NULL) {
  2467.         read_warning("Failed to create a unit!");
  2468.         return;
  2469.         }
  2470.     } else {
  2471.         read_warning("\"%s\" not a known unit type, skipping the form",
  2472.              c_string(head));
  2473.         return;
  2474.     }
  2475.     } else if (stringp(head)) {
  2476.     unit = find_unit_by_name(c_string(head));
  2477.     if (unit == NULL) {
  2478.         read_warning("Couldn't find a unit named \"%s\", skipping the form",
  2479.              c_string(head));
  2480.         return;
  2481.         }
  2482.     } else if (numberp(head)) {
  2483.     unit = find_unit_by_number(c_number(head));
  2484.     if (unit == NULL) {
  2485.         read_warning("Couldn't find a unit numbered %d, skipping the form",
  2486.              c_number(head));
  2487.         return;
  2488.         }
  2489.     }
  2490.     /* At this point we're guaranteed to have a unit to work with. */
  2491.     /* Modify the unit according to current defaults. */
  2492.     if (default_unit_side_number >= 0)
  2493.       nusn = default_unit_side_number;
  2494.     if (default_unit_cp >= 0)
  2495.       unit->cp = default_unit_cp;
  2496.     if (default_unit_hp >= 0)
  2497.       unit->hp = default_unit_hp;
  2498.     if (default_unit_cxp >= 0)
  2499.       unit->cxp = default_unit_cxp;
  2500.     init_supply(unit);  /* doesn't seem right? */
  2501.     /* Peel off fixed-position properties, if they're supplied. */
  2502.     if (numberp(car(props))) {
  2503.     unit->prevx = c_number(car(props)) + uxoffset - area.fullx;
  2504.     props = cdr(props);
  2505.     }
  2506.     if (numberp(car(props))) {
  2507.     unit->prevy = c_number(car(props)) + uyoffset - area.fully;
  2508.     props = cdr(props);
  2509.     }
  2510.     if (props != lispnil && !consp(car(props))) {
  2511.     nusn = c_number(eval(car(props)));
  2512.     props = cdr(props);
  2513.     }
  2514.     /* Now crunch through optional stuff.  The unit's properties must *already*
  2515.        be correct. */
  2516.     for (; props != lispnil; props = cdr(props)) {
  2517.     bdg = car(props);
  2518.     PARSE_PROPERTY(bdg, propname, val);
  2519.     if (numberp(val))
  2520.       numval = c_number(val);
  2521.     variablelength = FALSE;
  2522.     switch (keyword_code(propname)) {
  2523.       case K_N:
  2524.         unit->name = c_string(val);
  2525.         break;
  2526.       case K_SHARP:
  2527.         nuid = numval;
  2528.         break;
  2529.       case K_S:
  2530.         nusn = numval;
  2531.         break;
  2532.       case K_AT:
  2533.         unit->prevx = numval + uxoffset;
  2534.         unit->prevy = c_number(caddr(bdg)) + uyoffset;
  2535.         variablelength = TRUE;
  2536.         break;
  2537.       case K_NB:
  2538.         unit->number = numval;
  2539.         break;
  2540.       case K_CP:
  2541.         unit->cp = numval;
  2542.         break;
  2543.       case K_HP:
  2544.         unit->hp = numval;
  2545.         break;
  2546.       case K_CXP:
  2547.         unit->cxp = numval;
  2548.         break;
  2549.       case K_MO:
  2550.         unit->morale = numval;
  2551.         break;
  2552.       case K_M:
  2553.         interp_mtype_value_list(unit->supply, cdr(bdg));
  2554.         variablelength = TRUE;
  2555.         break;
  2556.       case K_TP:
  2557.         if (unit->tooling == NULL)
  2558.           init_unit_tooling(unit);
  2559.         interp_utype_value_list(unit->tooling, cdr(bdg));
  2560.         variablelength = TRUE;
  2561.         break;
  2562.       case K_OPINIONS:
  2563.         if (unit->opinions == NULL)
  2564.           init_unit_opinions(unit);
  2565.         interp_side_value_list(unit->opinions, cdr(bdg));
  2566.         variablelength = TRUE;
  2567.         break;
  2568.       case K_IN:
  2569.         /* Stash the Lisp object pointer for now - will be
  2570.            translated to unit pointer later. */
  2571.         unit->transport = (Unit *) val;
  2572.         break;
  2573.       case K_ACT:
  2574.         interp_unit_act(unit, cdr(bdg));
  2575.         variablelength = TRUE;
  2576.         break;
  2577.       case K_PLAN:
  2578.         interp_unit_plan(unit, cdr(bdg));
  2579.         variablelength = TRUE;
  2580.         break;
  2581.       case K_Z:
  2582.         unit->z = numval;
  2583.         break;
  2584.       case K_X:
  2585.         unit->hook = cdr(bdg);
  2586.         variablelength = TRUE;
  2587.         break;
  2588.       default:
  2589.         unknown_property("unit", unit_desig(unit), propname);
  2590.     }
  2591.     if (!variablelength && cddr(bdg) != lispnil)
  2592.       read_warning("Extra junk in the %s property of %s, ignoring",
  2593.                propname, unit_desig(unit));
  2594.     }
  2595.     /* If the unit id was given, assign it to the unit, avoiding
  2596.        duplication. */
  2597.     if (nuid > 0) {
  2598.         /* If this id is already in use by some other unit, complain. */
  2599.         unit2 = find_unit(nuid);
  2600.         if (unit2 != NULL && unit2 != unit)
  2601.       init_error("Id %d already in use by %s", nuid, unit_desig(unit2)); 
  2602.          /* Guaranteed distinct, safe to use. */
  2603.     unit->id = nuid;
  2604.     /* Ensure that future random ids won't step on this one. */
  2605.     nextid = max(nextid, nuid + 1);
  2606.     }
  2607.     if (nusn >= 0) {
  2608.     /* (should check that this is an allowed side?) */
  2609.     set_unit_side(unit, side_n(nusn));
  2610.     }
  2611.     /* (should fill in hook) */
  2612.     Dprintf("  Got %s\n", unit_desig(unit));
  2613. }
  2614.  
  2615. static void
  2616. interp_utype_value_list(arr, lis)
  2617. short *arr;
  2618. Obj *lis;
  2619. {
  2620.     int u = 0;
  2621.     Obj *rest, *head;
  2622.  
  2623.     for (rest = lis; rest != lispnil; rest = cdr(rest)) {
  2624.         head = car(rest);
  2625.         if (numberp(head)) {
  2626.         if (u < numutypes) {
  2627.             arr[u++] = c_number(head);
  2628.         } else {
  2629.         init_warning("too many numbers in list");
  2630.         }
  2631.     } else if (consp(head)) {
  2632.         if (symbolp(car(head))) {
  2633.         u = utype_from_name(c_string(car(head)));
  2634.         if (u != NONUTYPE) {
  2635.                 arr[u++] = c_number(cadr(head));
  2636.         }
  2637.         }
  2638.     }
  2639.     }
  2640. }
  2641.  
  2642. static void
  2643. interp_mtype_value_list(arr, lis)
  2644. short *arr;
  2645. Obj *lis;
  2646. {
  2647.     int m = 0;
  2648.     Obj *rest, *head;
  2649.  
  2650.     for (rest = lis; rest != lispnil; rest = cdr(rest)) {
  2651.         head = car(rest);
  2652.         if (numberp(head)) {
  2653.         if (m < nummtypes) {
  2654.             arr[m++] = c_number(head);
  2655.         } else {
  2656.         init_warning("too many numbers in list");
  2657.         }
  2658.     } else if (consp(head)) {
  2659.     }
  2660.     }
  2661. }
  2662.  
  2663. /* Interpret a unit's action state. */
  2664.  
  2665. static void
  2666. interp_unit_act(unit, props)
  2667. Unit *unit;
  2668. Obj *props;
  2669. {
  2670.     int numval;
  2671.     Obj *bdg, *propval;
  2672.     char *propname;
  2673.  
  2674.     if (unit->act == NULL) {
  2675.     unit->act = (ActorState *) xmalloc(sizeof(ActorState));
  2676.     /* Flag the action as undefined. */
  2677.     unit->act->nextaction.type = A_NONE;
  2678.     }
  2679.     for (; props != lispnil; props = cdr(props)) {
  2680.     bdg = car(props);
  2681.     PARSE_PROPERTY(bdg, propname, propval);
  2682.     if (numberp(propval))
  2683.       numval = c_number(propval);
  2684.     switch (keyword_code(propname)) {
  2685.       case K_ACP:
  2686.         unit->act->acp = numval;
  2687.         break;
  2688.       case K_ACP0:
  2689.         unit->act->initacp = numval;
  2690.         break;
  2691.       case K_AA:
  2692.         unit->act->actualactions = numval;
  2693.         break;
  2694.       case K_AM:
  2695.         unit->act->actualmoves = numval;
  2696.         break;
  2697.       case K_A:
  2698.         /* (should interp a spec for the next action) */
  2699.         break;
  2700.       default:
  2701.         unknown_property("unit actionstate", unit_desig(unit), propname);
  2702.     }
  2703.     }
  2704. }
  2705.  
  2706. /* Fill in a unit's plan. */
  2707.  
  2708. static void
  2709. interp_unit_plan(unit, props)
  2710. Unit *unit;
  2711. Obj *props;
  2712. {
  2713.     int numval;
  2714.     Obj *bdg, *propval, *plantypesym, *trest;
  2715.     char *propname;
  2716.     Goal *goal;
  2717.     Task *task;
  2718.  
  2719.     if (unit->plan == NULL) {
  2720.     /* Create the plan explicitly, even if unit type doesn't allow it
  2721.        (type might be changed later in the reading process). */
  2722.     unit->plan = (Plan *) xmalloc(sizeof(Plan));
  2723.     /* From init_unit_plan: can't call it directly, might not behave
  2724.        right (should fix to be callable from here - problem is that
  2725.        other unit props such as cp might not be set right yet) */
  2726.     /* Allow AIs to make this unit do things. */
  2727.     unit->plan->aicontrol = TRUE;
  2728.     /* Enable supply alarms by default. */
  2729.     unit->plan->supply_alarm = TRUE;
  2730.     }
  2731.     plantypesym = car(props);
  2732.     SYNTAX(props, symbolp(plantypesym), "plan type must be a symbol");
  2733.     unit->plan->type = lookup_plan_type(c_string(plantypesym));
  2734.     props = cdr(props);
  2735.     SYNTAX(props, numberp(car(props)), "plan creation turn must be a number");
  2736.     unit->plan->creationturn = c_number(car(props));
  2737.     props = cdr(props);
  2738.     for (; props != lispnil; props = cdr(props)) {
  2739.     bdg = car(props);
  2740.     PARSE_PROPERTY(bdg, propname, propval);
  2741.     if (numberp(propval))
  2742.       numval = c_number(propval);
  2743.     switch (keyword_code(propname)) {
  2744.       case K_START_TURN:
  2745.         unit->plan->startturn = numval;
  2746.         break;
  2747.       case K_END_TURN:
  2748.         unit->plan->endturn = numval;
  2749.         break;
  2750.       case K_ASLEEP:
  2751.         unit->plan->asleep = numval;
  2752.         break;
  2753.       case K_RESERVE:
  2754.         unit->plan->reserve = numval;
  2755.         break;
  2756.       case K_DELAYED:
  2757.         unit->plan->delayed = numval;
  2758.         break;
  2759.       case K_WAIT:
  2760.         unit->plan->waitingfortasks = numval;
  2761.         break;
  2762.       case K_AUTOTASK:
  2763.         unit->plan->autotask = numval;
  2764.         break;
  2765.       case K_AI_CONTROL:
  2766.         unit->plan->aicontrol = numval;
  2767.         break;
  2768.       case K_SUPPLY_ALARM:
  2769.         unit->plan->supply_alarm = numval;
  2770.         break;
  2771.       case K_SUPPLY_IS_LOW:
  2772.         unit->plan->supply_is_low = numval;
  2773.         break;
  2774.       case K_WAIT_TRANSPORT:
  2775.         unit->plan->waitingfortransport = numval;
  2776.         break;
  2777.       case K_GOAL:
  2778.         goal = interp_goal(cdr(bdg));
  2779.         unit->plan->maingoal = goal;
  2780.         break;
  2781.       case K_FORMATION:
  2782.         goal = interp_goal(cdr(bdg));
  2783.         unit->plan->formation = goal;
  2784.         /* (should do after all units read in!) */
  2785.         unit->plan->funit = find_unit(goal->args[0]);
  2786.         break;
  2787.       case K_TASKS:
  2788.         for (trest = cdr(bdg); trest != lispnil; trest = cdr(trest)) {
  2789.             task = interp_task(car(trest));
  2790.         if (task) {
  2791.             /* (should add tasks in reverse order) */
  2792.             task->next = unit->plan->tasks;
  2793.             unit->plan->tasks = task;
  2794.         }
  2795.         }
  2796.         break;
  2797.       default:
  2798.         unknown_property("unit plan", unit_desig(unit), propname);
  2799.     }
  2800.     }
  2801. }
  2802.  
  2803. int
  2804. lookup_plan_type(name)
  2805. char *name;
  2806. {
  2807.     int i;
  2808.     extern char *plantypenames[];
  2809.  
  2810.     for (i = 0; plantypenames[i] != NULL; ++i)
  2811.       /* should get real enum */
  2812.       if (strcmp(name, plantypenames[i]) == 0)
  2813.     return i;
  2814.     return PLAN_NONE;
  2815. }
  2816.  
  2817. static Task *
  2818. interp_task(form)
  2819. Obj *form;
  2820. {
  2821.     int tasktype, numargs, i;
  2822.     char *argtypes;
  2823.     Obj *tasktypesym;
  2824.     Task *task;
  2825.  
  2826.     tasktypesym = car(form);
  2827.     SYNTAX_RETURN(form, symbolp(tasktypesym), "task type must be a symbol", NULL);
  2828.     tasktype = lookup_task_type(c_string(tasktypesym));
  2829.     task = create_task(tasktype);
  2830.     form = cdr(form);
  2831.     task->execnum = c_number(car(form));
  2832.     form = cdr(form);
  2833.     task->retrynum = c_number(car(form));
  2834.     form = cdr(form);
  2835.     argtypes = taskdefns[tasktype].argtypes;
  2836.     numargs = strlen(argtypes);
  2837.     for (i = 0; i < numargs; ++i) {
  2838.     if (form == lispnil)
  2839.       break;
  2840.     SYNTAX_RETURN(form, numberp(car(form)), "task arg must be a number", NULL);
  2841.     task->args[i] = c_number(car(form));
  2842.     form = cdr(form);
  2843.     }
  2844.     /* Warn about unused data, but not a serious problem. */
  2845.     if (form != lispnil)
  2846.       read_warning("Excess args for task %s", task_desig(task));
  2847.     return task;
  2848. }
  2849.  
  2850. /* (to task.c?) */
  2851.  
  2852. int
  2853. lookup_task_type(name)
  2854. char *name;
  2855. {
  2856.     int i;
  2857.  
  2858.     for (i = 0; taskdefns[i].name != NULL; ++i)
  2859.       if (strcmp(name, taskdefns[i].name) == 0)
  2860.     return i; /* should get real enum? */
  2861.     return TASK_NONE;
  2862. }
  2863.  
  2864. static Goal *
  2865. interp_goal(form)
  2866. Obj *form;
  2867. {
  2868.     int goaltype, tf, numargs, i;
  2869.     char *argtypes;
  2870.     Obj *goaltypesym;
  2871.     Goal *goal;
  2872.     Side *side;
  2873.  
  2874.     SYNTAX_RETURN(form, numberp(car(form)), "goal side must be a number", NULL);
  2875.     side = side_n(c_number(car(form)));
  2876.     form = cdr(form);
  2877.     SYNTAX_RETURN(form, numberp(car(form)), "goal tf must be a number", NULL);
  2878.     tf = c_number(car(form));
  2879.     form = cdr(form);
  2880.     goaltypesym = car(form);
  2881.     SYNTAX_RETURN(form, symbolp(goaltypesym), "goal type must be a symbol", NULL);
  2882.     goaltype = lookup_goal_type(c_string(goaltypesym));
  2883.     goal = create_goal(goaltype, side, tf);
  2884.     form = cdr(form);
  2885.     argtypes = goaldefns[goaltype].argtypes;
  2886.     numargs = strlen(argtypes);
  2887.     for (i = 0; i < numargs; ++i) {
  2888.     if (form == lispnil)
  2889.       break;
  2890.     SYNTAX_RETURN(form, numberp(car(form)), "goal arg must be a number", NULL);
  2891.     goal->args[i] = c_number(car(form));
  2892.     form = cdr(form);
  2893.     }
  2894.     /* Warn about unused data, but not a serious problem. */
  2895.     if (form != lispnil)
  2896.       read_warning("Excess args for goal %s", goal_desig(goal));
  2897.     return goal;
  2898. }
  2899.  
  2900. /* (to goal.c?) */
  2901.  
  2902. int
  2903. lookup_goal_type(name)
  2904. char *name;
  2905. {
  2906.     int i;
  2907.  
  2908.     for (i = 0; goaldefns[i].name != NULL; ++i)
  2909.       if (strcmp(name, goaldefns[i].name) == 0)
  2910.     return i; /* should get real enum? */
  2911.     return GOAL_NO;
  2912. }
  2913.  
  2914. /* Make a namer from the form. */
  2915.  
  2916. static void
  2917. interp_namer(form)
  2918. Obj *form;
  2919. {
  2920.     Obj *id = cadr(form), *meth = car(cddr(form));
  2921.  
  2922.     if (symbolp(id)) {
  2923.     setq(id, make_namer(id, meth));
  2924.     }
  2925. }
  2926.  
  2927. static void
  2928. interp_text_generator(form)
  2929. Obj *form;
  2930. {
  2931.     Obj *id = cadr(form);
  2932.  
  2933.     if (symbolp(id)) {
  2934.     setq(id, lispnil);
  2935.     }
  2936. }
  2937.  
  2938. /* Make a scorekeeper from the given form. */
  2939.  
  2940. static void
  2941. interp_scorekeeper(form)
  2942. Obj *form;
  2943. {
  2944.     int id = 0;
  2945.     char *propname;
  2946.     Obj *props = cdr(form), *bdg, *propval;
  2947.     Scorekeeper *sk = NULL;
  2948.  
  2949.     if (numberp(car(props))) {
  2950.     id = c_number(car(props));
  2951.     props = cdr(props);
  2952.     }
  2953.     if (id > 0) {
  2954.     /* (should attempt to find scorekeeper) */
  2955.     }
  2956.     /* Create a new scorekeeper object if necessary. */
  2957.     if (sk == NULL) {
  2958.     sk = create_scorekeeper();
  2959.     if (id > 0) {
  2960.         sk->id = id;
  2961.     }
  2962.     }
  2963.     /* Interpret the properties. */
  2964.     for (; props != lispnil; props = cdr(props)) {
  2965.     bdg = car(props);
  2966.     PARSE_PROPERTY(bdg, propname, propval);
  2967.     switch (keyword_code(propname)) {
  2968.       case K_TITLE:
  2969.         sk->title = c_string(propval);
  2970.         break;
  2971.       case K_WHEN:
  2972.         sk->when = propval;
  2973.         break;
  2974.       case K_APPLIES_TO:
  2975.         sk->who = propval;
  2976.         break;
  2977.       case K_KNOWN_TO:
  2978.         sk->knownto = propval;
  2979.         break;
  2980.       case K_TRIGGER:
  2981.         sk->trigger = propval;
  2982.         break;
  2983.       case K_DO:
  2984.         sk->body = propval;
  2985.         break;
  2986.       case K_MESSAGES:
  2987.         sk->messages = propval;
  2988.         break;
  2989.       case K_TRIGGERED:
  2990.         sk->triggered = c_number(propval);
  2991.         break;
  2992.       case K_INITIAL:
  2993.         sk->initial = c_number(propval);
  2994.         break;
  2995.       case K_NOTES:
  2996.         sk->notes = propval;
  2997.         break;
  2998.       default:
  2999.         unknown_property("scorekeeper", "??", propname);
  3000.     }
  3001.     }
  3002. }
  3003.  
  3004. /* Make a past unit from the form. */
  3005.  
  3006. static void
  3007. interp_past_unit(form)
  3008. Obj *form;
  3009. {
  3010.     int u = NONUTYPE, nid;
  3011.     char *propname;
  3012.     Obj *props, *bdg, *propval;
  3013.     PastUnit *pastunit;
  3014.  
  3015.     Dprintf("Reading a past unit from ");
  3016.     Dprintlisp(form);
  3017.     Dprintf("\n");
  3018.     props = cdr(form);
  3019.     if (numberp(car(props))) {
  3020.     nid = c_number(car(props));
  3021.     props = cdr(props);
  3022.     } else {
  3023.     /* (should be error) */
  3024.     }
  3025.     if (symbolp(car(props))) {
  3026.     u = utype_from_name(c_string(car(props)));
  3027.     props = cdr(props);
  3028.     }
  3029.     if (u == NONUTYPE) {
  3030.     read_warning("bad exu");
  3031.     return;
  3032.     }
  3033.     pastunit = create_past_unit(u, nid);
  3034.     /* Peel off fixed-position properties, if they're supplied. */
  3035.     if (numberp(car(props))) {
  3036.     pastunit->x = c_number(eval(car(props)));
  3037.     props = cdr(props);
  3038.     }
  3039.     if (numberp(car(props))) {
  3040.     pastunit->y = c_number(eval(car(props)));
  3041.     props = cdr(props);
  3042.     }
  3043.     if (!consp(car(props))) {
  3044.     pastunit->side = side_n(c_number(eval(car(props))));
  3045.     props = cdr(props);
  3046.     }
  3047.     for (; props != lispnil; props = cdr(props)) {
  3048.     bdg = car(props);
  3049.     PARSE_PROPERTY(bdg, propname, propval);
  3050.     switch (keyword_code(propname)) {
  3051.       case K_Z:
  3052.         pastunit->z = c_number(propval);
  3053.         break;
  3054.       case K_N:
  3055.         pastunit->name = c_string(propval);
  3056.         break;
  3057.       case K_NB:
  3058.         pastunit->number = c_number(propval);
  3059.         break;
  3060.       default:
  3061.         unknown_property("exu", "??", propname);
  3062.     }
  3063.     }
  3064. }
  3065.  
  3066. /* Make a historical event from the form. */
  3067.  
  3068. static void
  3069. interp_history(form)
  3070. Obj *form;
  3071. {
  3072.     int startdate, type, i;
  3073.     char *typename;
  3074.     Obj *props, *bdg, *propval;
  3075.     HistEvent *hevt;
  3076.  
  3077.     Dprintf("Reading a hist event from ");
  3078.     Dprintlisp(form);
  3079.     Dprintf("\n");
  3080.     props = cdr(form);
  3081.     if (numberp(car(props))) {
  3082.     startdate = c_number(car(props));
  3083.     props = cdr(props);
  3084.     } else {
  3085.     /* (should be error) */
  3086.     }
  3087.     if (symbolp(car(props))) {
  3088.     typename = c_string(car(props));
  3089.     type = -1;
  3090.     for (i = 0; hevtdefns[i].name != NULL; ++i)
  3091.       if (strcmp(typename, hevtdefns[i].name) == 0) {
  3092.           type = i;
  3093.           break;
  3094.       }
  3095.     props = cdr(props);
  3096.     } else {
  3097.     /* (should be error) */
  3098.     }
  3099.     hevt = create_historical_event(type);
  3100.     hevt->startdate = startdate;
  3101.     /* Get the bit vector of observers. */
  3102.     if (numberp(car(props))) {
  3103.     hevt->observers = c_number(car(props));
  3104.     props = cdr(props);
  3105.     } else {
  3106.     /* (should be error) */
  3107.     }
  3108.     /* Read up to 4 remaining numbers. */
  3109.     i = 0;
  3110.     for (; props != lispnil && i < 4; props = cdr(props)) {
  3111.     hevt->data[i] = c_number(car(props));
  3112.     }
  3113.     /* Insert the newly created event. */
  3114.     /* (linking code should be in its own routine) */
  3115.     hevt->next = history;
  3116.     hevt->prev = history->prev;
  3117.     history->prev->next = hevt;
  3118.     history->prev = hevt;
  3119. }
  3120.  
  3121. /* Designer is trying to define too many different types. */
  3122.  
  3123. static void
  3124. too_many_types(typename, maxnum, name)
  3125. char *typename;
  3126. int maxnum;
  3127. Obj *name;
  3128. {
  3129.     read_warning("Limited to %d types of %s", maxnum, typename);
  3130.     sprintlisp(spbuf, name);
  3131.     read_warning("(Failed to create type with name `%s')", spbuf);
  3132. }
  3133.  
  3134. /* Property name is unknown, either misspelled or misapplied. */
  3135.  
  3136. static void
  3137. unknown_property(type, inst, name)
  3138. char *type, *inst, *name;
  3139. {
  3140.     read_warning("The %s form %s has no property named %s", type, inst, name);
  3141. }
  3142.  
  3143. /* Globals used to communicate with the RLE reader. */
  3144.  
  3145. int layer_use_default;
  3146. int layer_default;
  3147. int layer_multiplier;
  3148. int layer_adder;
  3149. int layer_area_x, layer_area_y;
  3150. int layer_area_w, layer_area_h;
  3151.  
  3152. int ignore_specials;
  3153.  
  3154. static void
  3155. read_layer(contents, setter)
  3156. Obj *contents;
  3157. void (*setter) PROTO ((int, int, int));
  3158. {
  3159.     int i, slen, n, ix, len, usechartable = FALSE;
  3160.     char *str;
  3161.     short chartable[256];
  3162.     Obj *rest, *desc, *rest2, *subdesc, *sym, *num;
  3163.  
  3164.     layer_use_default = FALSE;
  3165.     layer_default = 0;
  3166.     layer_multiplier = 1;
  3167.     layer_adder = 0;
  3168.     layer_area_x = area.fullx;  layer_area_y = area.fully;
  3169.     layer_area_w = area.width;  layer_area_h = area.height;
  3170.     if (area.fullwidth > 0)
  3171.       layer_area_w = area.fullwidth;
  3172.     if (area.fullheight > 0)
  3173.       layer_area_h = area.fullheight;
  3174.     ignore_specials = FALSE;
  3175.     for (rest = contents; rest != lispnil; rest = cdr(rest)) {
  3176.     desc = car(rest);
  3177.     if (stringp(desc)) {
  3178.         /* Read from here to the end of the list, interpreting as
  3179.            contents. */
  3180.         read_rle(rest, setter, (usechartable ? chartable : NULL));
  3181.         return;
  3182.     } else if (consp(desc) && symbolp(car(desc))) {
  3183.         switch (keyword_code(c_string(car(desc)))) {
  3184.           case K_CONSTANT:
  3185.         /* should set to a constant value taken from cadr */
  3186.         read_warning("Constant layers not supported yet");
  3187.         return;
  3188.           case K_SUBAREA:
  3189.             /* should apply data to a subarea */
  3190.         read_warning("Layer subareas not supported yet");
  3191.         break;
  3192.           case K_XFORM:
  3193.         layer_multiplier = c_number(cadr(desc));
  3194.         layer_adder = c_number(caddr(desc));
  3195.         break;
  3196.           case K_BY_BITS:
  3197.         break;
  3198.           case K_BY_CHAR:
  3199.         /* Assign each char to its corresponding index. */
  3200.         for (i = 0; i < 255; ++i) chartable[i] = 0;
  3201.         str = c_string(cadr(desc));
  3202.         len = strlen(str);
  3203.         for (i = 0; i < len; ++i) {
  3204.             chartable[(int) str[i]] = i;
  3205.             /* If special chars in by-char string, flag it. */
  3206.             if (str[i] == '*' || str[i] == ',')
  3207.               ignore_specials = TRUE;
  3208.         }
  3209.         usechartable = TRUE;
  3210.         break;
  3211.           case K_BY_NAME:
  3212.         /* Work through list and match names to numbers. */
  3213.         for (i = 0; i < 255; ++i) chartable[i] = 0;
  3214.         desc = cdr(desc);
  3215.         /* Support optional explicit string a la by-char. */
  3216.         if (stringp(car(desc))) {
  3217.             str = c_string(car(desc));
  3218.             slen = strlen(str);
  3219.             for (i = 0; i < slen; ++i)
  3220.               chartable[(int) str[i]] = i;
  3221.             desc = cdr(desc);
  3222.         } else {
  3223.             str = NULL;
  3224.         }
  3225.         i = 0;
  3226.         for (rest2 = desc; rest2 != lispnil; rest2 = cdr(rest2)) {
  3227.             subdesc = car(rest2);
  3228.             if (symbolp(subdesc)) {
  3229.                 sym = subdesc;
  3230.                 ix = i++;
  3231.             } else if (consp(subdesc)) {
  3232.                 sym = car(subdesc);
  3233.                 num = cadr(subdesc);
  3234.                 SYNTAX(num, numberp(num),
  3235.                    "by-name explicit value is not a number");
  3236.                 ix = c_number(num);
  3237.             } else {
  3238.                 read_warning("garbage by-name subdesc, ignoring");
  3239.                 continue;
  3240.             }
  3241.             /* Eval the symbol into something resembling a value. */
  3242.             sym = eval(sym);
  3243.             SYNTAX(sym, numberishp(sym),
  3244.                "by-name index is not numberish");
  3245.             n = c_number(sym);
  3246.             chartable[(str ? str[ix] : 'a' + ix)] = n;
  3247.         }
  3248.         usechartable = TRUE;
  3249.         break;
  3250.           default:
  3251.         if (readerrbuf == NULL)
  3252.           readerrbuf = (char *) xmalloc(BUFSIZE);
  3253.         sprintlisp(readerrbuf, desc);
  3254.         read_warning("Ignoring garbage terrain description %s",
  3255.                  readerrbuf);
  3256.         }
  3257.     }
  3258.     }
  3259. }
  3260.  
  3261. /* General RLE reader.  This basically parses the run lengths and calls
  3262.    the function that records what was read. */
  3263.  
  3264. static void
  3265. read_rle(contents, setter, chartable)
  3266. Obj *contents;
  3267. void (*setter) PROTO ((int, int, int));
  3268. short *chartable;
  3269. {
  3270.     char ch, *rowstr;
  3271.     int i, x, y, run, val, sawval, x1, y1, numbadchars = 0;
  3272.     Obj *rest;
  3273.  
  3274.     rest = contents;
  3275.     y = layer_area_h - 1;
  3276.     while (rest != lispnil && y >= 0) {
  3277.     /* should error check ... */
  3278.     rowstr = c_string(car(rest));
  3279.     i = 0;
  3280.     x = 0;  /* depends on shape of saved data... */
  3281.     while ((ch = rowstr[i++]) != '\0' && x < layer_area_w) {
  3282.         sawval = FALSE;
  3283.         if (isdigit(ch)) {
  3284.         /* Interpret a substring of digits as a run length. */
  3285.         run = ch - '0';
  3286.         while ((ch = rowstr[i++]) != 0 && isdigit(ch)) {
  3287.             run = run * 10 + ch - '0';
  3288.         }
  3289.         /* A '*' separates a run and a numeric value. */
  3290.         if (ch == '*' && !ignore_specials) {
  3291.             ch = rowstr[i++];
  3292.             /* If we're seeing garbled data, skip to the next line. */
  3293.             if (ch == '\0')
  3294.               goto recovery;
  3295.             /* Interpret these digits as a value. */
  3296.             if (isdigit(ch)) {
  3297.             val = ch - '0';
  3298.             while ((ch = rowstr[i++]) != 0 && isdigit(ch)) {
  3299.                 val = val * 10 + ch - '0';
  3300.             }
  3301.             sawval = TRUE;
  3302.             } else {
  3303.             /* Some other char seen - just ignore the '*' then. */
  3304.             }
  3305.             /* If we're seeing garbled data, skip to the next line. */
  3306.             if (ch == '\0')
  3307.               goto recovery;
  3308.         }
  3309.         /* If we're seeing garbled data, skip to the next line. */
  3310.         if (ch == '\0')
  3311.           goto recovery;
  3312.         } else {
  3313.         run = 1;
  3314.         }
  3315.         if (ch == ',' && !ignore_specials) {
  3316.             if (!sawval) {
  3317.             /* This was a value instead of a run length. */
  3318.             val = run;
  3319.             run = 1;
  3320.         } else {
  3321.             /* Comma is just being a separator. */
  3322.         }
  3323.         } else if (chartable != NULL) {
  3324.         val = chartable[ch];
  3325.         } else if (between('a', ch, '~')) {
  3326.         val = ch - 'a';
  3327.         } else if (between(':', ch, '[')) {
  3328.         val = ch - ':' + 30;
  3329.         } else {
  3330.             /* Warn about strange characters. */
  3331.         ++numbadchars;
  3332.         if (numbadchars <= 5) {
  3333.             read_warning(
  3334.              "Bad char '%c' (0x%x) in layer, using NUL instead",
  3335.                  ch, ch);
  3336.             /* Clarify that we're not going to report all bad chars. */
  3337.             if (numbadchars == 5)
  3338.               read_warning(
  3339.              "Additional bad chars will not be reported individually");
  3340.         }
  3341.         val = 0;
  3342.         }
  3343.         val = val * layer_multiplier + layer_adder;
  3344.         /* Given a run of values, stuff them into the layer. */
  3345.         while (run-- > 0) {
  3346.             x1 = wrapx(x - layer_area_x);  y1 = y - layer_area_y;
  3347.             if (in_area(x1, y1))
  3348.           (*setter)(x1, y1, val);
  3349.         ++x;
  3350.         }
  3351.     }
  3352.       recovery:
  3353.     /* Fill-in string may be too short for this row; just leave
  3354.        the rest of it alone, assume that somebody has assured
  3355.        that the contents are reasonable. */
  3356.     rest = cdr(rest);
  3357.     y--;
  3358.     }
  3359.     /* Report the count of garbage chars, in case there were a great many. */
  3360.     if (numbadchars > 0)
  3361.       init_warning("A total of %d bad chars were present", numbadchars);
  3362. }
  3363.